From 8bf9a44f8319f9f7b0647fb3736f9c00b165b446 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 25 Aug 2004 04:26:49 +0000 Subject: [PATCH] some minor cleanups in preparation for landing of s48 bignums --- Makefile | 1 + library/cross-compiler.factor | 2 + library/image.factor | 4 +- native/arithmetic.c | 49 +++++++++++++ native/arithmetic.h | 130 +++++++--------------------------- native/bignum.c | 99 +++++++++++--------------- native/bignum.h | 38 +++++----- native/complex.c | 83 ++++++++++++---------- native/complex.h | 21 +++--- native/float.c | 50 ++++++------- native/float.h | 20 +++--- native/ratio.c | 99 ++++++++++++-------------- native/ratio.h | 21 +++--- 13 files changed, 284 insertions(+), 333 deletions(-) diff --git a/Makefile b/Makefile index d577b76fea..b5a42bfb56 100644 --- a/Makefile +++ b/Makefile @@ -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 \ diff --git a/library/cross-compiler.factor b/library/cross-compiler.factor index 36439f0041..a7a44fddc4 100644 --- a/library/cross-compiler.factor +++ b/library/cross-compiler.factor @@ -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 ; diff --git a/library/image.factor b/library/image.factor index a96ee66ab3..00aa136f4e 100644 --- a/library/image.factor +++ b/library/image.factor @@ -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 ) diff --git a/native/arithmetic.c b/native/arithmetic.c index 9ce426cbb8..c9200dd647 100644 --- a/native/arithmetic.c +++ b/native/arithmetic.c @@ -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)); diff --git a/native/arithmetic.h b/native/arithmetic.h index 52cff586f0..4c003ccf3f 100644 --- a/native/arithmetic.h +++ b/native/arithmetic.h @@ -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; \ } diff --git a/native/bignum.c b/native/bignum.c index 4d009d1f7c..b4c0358588 100644 --- a/native/bignum.c +++ b/native/bignum.c @@ -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))); } diff --git a/native/bignum.h b/native/bignum.h index b8208f325a..ecf6468f08 100644 --- a/native/bignum.h +++ b/native/bignum.h @@ -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); diff --git a/native/complex.c b/native/complex.c index 0949e8c9fc..e9f201be40 100644 --- a/native/complex.c +++ b/native/complex.c @@ -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; diff --git a/native/complex.h b/native/complex.h index cb0fc751e4..7fffa7479e 100644 --- a/native/complex.h +++ b/native/complex.h @@ -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); diff --git a/native/float.c b/native/float.c index a3f5d9786a..9982e3fce7 100644 --- a/native/float.c +++ b/native/float.c @@ -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) diff --git a/native/float.h b/native/float.h index b138237519..86bccaa21d 100644 --- a/native/float.h +++ b/native/float.h @@ -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); diff --git a/native/ratio.c b/native/ratio.c index e581aaebf9..c131ae9943 100644 --- a/native/ratio.c +++ b/native/ratio.c @@ -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)); } diff --git a/native/ratio.h b/native/ratio.h index cfb0d89cc1..eedde3b7a2 100644 --- a/native/ratio.h +++ b/native/ratio.h @@ -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);