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
OBJS = native/arithmetic.o native/array.o native/bignum.o \
native/s48_bignum.o \
native/complex.o native/cons.o native/error.o \
native/factor.o native/file.o native/fixnum.o \
native/float.o native/gc.o \

2
library/cross-compiler.factor
View File

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

4
library/image.factor
View File

@ -142,7 +142,9 @@ USE: words
#! Very bad!
object-tag here-as >r
bignum-type >header emit
0 emit ( alignment -- FIXME 64-bit arch )
4 emit ( capacity )
0 emit ( sign XXXX )
0 emit ( pad XXXX )
( bignum -- ) emit64 r> ;
( Special objects )

49
native/arithmetic.c
View File

@ -1,5 +1,54 @@
#include "factor.h"
CELL upgraded_arithmetic_type(CELL type1, CELL type2)
{
switch(type1)
{
case FIXNUM_TYPE:
return type2;
case BIGNUM_TYPE:
switch(type2)
{
case FIXNUM_TYPE:
return type1;
default:
return type2;
}
case RATIO_TYPE:
switch(type2)
{
case FIXNUM_TYPE:
case BIGNUM_TYPE:
return type1;
default:
return type2;
}
case FLOAT_TYPE:
switch(type2)
{
case FIXNUM_TYPE:
case BIGNUM_TYPE:
case RATIO_TYPE:
return type1;
default:
return type2;
}
case COMPLEX_TYPE:
switch(type2)
{
case FIXNUM_TYPE:
case BIGNUM_TYPE:
case RATIO_TYPE:
case FLOAT_TYPE:
return type1;
default:
return type2;
}
default:
return type1;
}
}
BIGNUM* fixnum_to_bignum(CELL n)
{
return bignum((BIGNUM_2)untag_fixnum_fast(n));

130
native/arithmetic.h
View File

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

99
native/bignum.c
View File

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

38
native/bignum.h
View File

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

83
native/complex.c
View File

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

21
native/complex.h
View File

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

50
native/float.c
View File

@ -54,64 +54,54 @@ void primitive_float_to_bits(void)
drepl(tag_object(bignum(f_raw)));
}
CELL number_eq_float(CELL x, CELL y)
CELL number_eq_float(FLOAT* x, FLOAT* y)
{
return tag_boolean(((FLOAT*)UNTAG(x))->n
== ((FLOAT*)UNTAG(y))->n);
return tag_boolean(x->n == y->n);
}
CELL add_float(CELL x, CELL y)
CELL add_float(FLOAT* x, FLOAT* y)
{
return tag_object(make_float(((FLOAT*)UNTAG(x))->n
+ ((FLOAT*)UNTAG(y))->n));
return tag_object(make_float(x->n + y->n));
}
CELL subtract_float(CELL x, CELL y)
CELL subtract_float(FLOAT* x, FLOAT* y)
{
return tag_object(make_float(((FLOAT*)UNTAG(x))->n
- ((FLOAT*)UNTAG(y))->n));
return tag_object(make_float(x->n - y->n));
}
CELL multiply_float(CELL x, CELL y)
CELL multiply_float(FLOAT* x, FLOAT* y)
{
return tag_object(make_float(((FLOAT*)UNTAG(x))->n
* ((FLOAT*)UNTAG(y))->n));
return tag_object(make_float(x->n * y->n));
}
CELL divide_float(CELL x, CELL y)
CELL divide_float(FLOAT* x, FLOAT* y)
{
return tag_object(make_float(((FLOAT*)UNTAG(x))->n
/ ((FLOAT*)UNTAG(y))->n));
return tag_object(make_float(x->n / y->n));
}
CELL divfloat_float(CELL x, CELL y)
CELL divfloat_float(FLOAT* x, FLOAT* y)
{
return tag_object(make_float(((FLOAT*)UNTAG(x))->n
/ ((FLOAT*)UNTAG(y))->n));
return tag_object(make_float(x->n / y->n));
}
CELL less_float(CELL x, CELL y)
CELL less_float(FLOAT* x, FLOAT* y)
{
return tag_boolean(((FLOAT*)UNTAG(x))->n
< ((FLOAT*)UNTAG(y))->n);
return tag_boolean(x->n < y->n);
}
CELL lesseq_float(CELL x, CELL y)
CELL lesseq_float(FLOAT* x, FLOAT* y)
{
return tag_boolean(((FLOAT*)UNTAG(x))->n
<= ((FLOAT*)UNTAG(y))->n);
return tag_boolean(x->n <= y->n);
}
CELL greater_float(CELL x, CELL y)
CELL greater_float(FLOAT* x, FLOAT* y)
{
return tag_boolean(((FLOAT*)UNTAG(x))->n
> ((FLOAT*)UNTAG(y))->n);
return tag_boolean(x->n > y->n);
}
CELL greatereq_float(CELL x, CELL y)
CELL greatereq_float(FLOAT* x, FLOAT* y)
{
return tag_boolean(((FLOAT*)UNTAG(x))->n
>= ((FLOAT*)UNTAG(y))->n);
return tag_boolean(x->n >= y->n);
}
void primitive_facos(void)

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_bits(void);
CELL number_eq_float(CELL x, CELL y);
CELL add_float(CELL x, CELL y);
CELL subtract_float(CELL x, CELL y);
CELL multiply_float(CELL x, CELL y);
CELL divide_float(CELL x, CELL y);
CELL divfloat_float(CELL x, CELL y);
CELL less_float(CELL x, CELL y);
CELL lesseq_float(CELL x, CELL y);
CELL greater_float(CELL x, CELL y);
CELL greatereq_float(CELL x, CELL y);
CELL number_eq_float(FLOAT* x, FLOAT* y);
CELL add_float(FLOAT* x, FLOAT* y);
CELL subtract_float(FLOAT* x, FLOAT* y);
CELL multiply_float(FLOAT* x, FLOAT* y);
CELL divide_float(FLOAT* x, FLOAT* y);
CELL divfloat_float(FLOAT* x, FLOAT* y);
CELL less_float(FLOAT* x, FLOAT* y);
CELL lesseq_float(FLOAT* x, FLOAT* y);
CELL greater_float(FLOAT* x, FLOAT* y);
CELL greatereq_float(FLOAT* x, FLOAT* y);
void primitive_facos(void);
void primitive_fasin(void);

99
native/ratio.c
View File

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

21
native/ratio.h
View File

@ -15,17 +15,18 @@ INLINE CELL tag_ratio(RATIO* ratio)
}
RATIO* ratio(CELL numerator, CELL denominator);
RATIO* to_ratio(CELL x);
void primitive_ratiop(void);
void primitive_numerator(void);
void primitive_denominator(void);
CELL number_eq_ratio(CELL x, CELL y);
CELL add_ratio(CELL x, CELL y);
CELL subtract_ratio(CELL x, CELL y);
CELL multiply_ratio(CELL x, CELL y);
CELL divide_ratio(CELL x, CELL y);
CELL divfloat_ratio(CELL x, CELL y);
CELL less_ratio(CELL x, CELL y);
CELL lesseq_ratio(CELL x, CELL y);
CELL greater_ratio(CELL x, CELL y);
CELL greatereq_ratio(CELL x, CELL y);
CELL number_eq_ratio(RATIO* x, RATIO* y);
CELL add_ratio(RATIO* x, RATIO* y);
CELL subtract_ratio(RATIO* x, RATIO* y);
CELL multiply_ratio(RATIO* x, RATIO* y);
CELL divide_ratio(RATIO* x, RATIO* y);
CELL divfloat_ratio(RATIO* x, RATIO* y);
CELL less_ratio(RATIO* x, RATIO* y);
CELL lesseq_ratio(RATIO* x, RATIO* y);
CELL greater_ratio(RATIO* x, RATIO* y);
CELL greatereq_ratio(RATIO* x, RATIO* y);