first cut at floats
parent
3ad0b47e2d
commit
e45fc3c0f0
2
build.sh
2
build.sh
|
@ -1,5 +1,5 @@
|
|||
export CC=gcc34
|
||||
export CFLAGS="-pedantic -Wall -Winline -Os -march=pentium4 -fomit-frame-pointer"
|
||||
export CFLAGS="-pedantic -Wall -Winline -O2 -march=pentium4 -fomit-frame-pointer"
|
||||
|
||||
$CC $CFLAGS -o f native/*.c
|
||||
|
||||
|
|
|
@ -42,6 +42,13 @@ USE: test
|
|||
|
||||
[ t ] [ 1 3 / 1 3 / = ] unit-test
|
||||
|
||||
[ -10 ] [ -100 10 /i ] unit-test
|
||||
[ 10 ] [ -100 -10 /i ] unit-test
|
||||
[ -10 ] [ 100 -10 /i ] unit-test
|
||||
[ -10 ] [ -100 >bignum 10 >bignum /i ] unit-test
|
||||
[ 10 ] [ -100 >bignum -10 >bignum /i ] unit-test
|
||||
[ -10 ] [ 100 >bignum -10 >bignum /i ] unit-test
|
||||
|
||||
[ 3/2 ] [ 1 1/2 + ] unit-test
|
||||
[ 3/2 ] [ 1 >bignum 1/2 + ] unit-test
|
||||
[ -1/2 ] [ 1/2 1 - ] unit-test
|
||||
|
@ -50,3 +57,17 @@ USE: test
|
|||
|
||||
[ 1 ] [ 1/2 1/2 / ] unit-test
|
||||
[ 27/4 ] [ 3/2 2/9 / ] unit-test
|
||||
|
||||
[ t ] [ 5768 476343 < ] unit-test
|
||||
[ t ] [ 5768 476343 <= ] unit-test
|
||||
[ f ] [ 5768 476343 > ] unit-test
|
||||
[ f ] [ 5768 476343 >= ] unit-test
|
||||
[ t ] [ 3434 >bignum 3434 >= ] unit-test
|
||||
[ t ] [ 3434 3434 >bignum <= ] unit-test
|
||||
|
||||
[ t ] [ 1 1/3 > ] unit-test
|
||||
[ t ] [ 2/3 3/4 <= ] unit-test
|
||||
[ f ] [ -2/3 1/3 > ] unit-test
|
||||
|
||||
[ 3 ] [ 10/3 >integer ] unit-test
|
||||
[ -3 ] [ -10/3 >integer ] unit-test
|
||||
|
|
|
@ -10,9 +10,14 @@ RATIO* fixnum_to_ratio(CELL n)
|
|||
return ratio(n,tag_fixnum(1));
|
||||
}
|
||||
|
||||
FLOAT* fixnum_to_float(CELL n)
|
||||
{
|
||||
return make_float((double)untag_fixnum_fast(n));
|
||||
}
|
||||
|
||||
FIXNUM bignum_to_fixnum(CELL tagged)
|
||||
{
|
||||
return (FIXNUM)(untag_bignum(tagged)->n);
|
||||
return (FIXNUM)(((BIGNUM*)UNTAG(tagged))->n);
|
||||
}
|
||||
|
||||
RATIO* bignum_to_ratio(CELL n)
|
||||
|
@ -20,6 +25,17 @@ RATIO* bignum_to_ratio(CELL n)
|
|||
return ratio(n,tag_fixnum(1));
|
||||
}
|
||||
|
||||
FLOAT* bignum_to_float(CELL tagged)
|
||||
{
|
||||
return make_float((double)((BIGNUM*)UNTAG(tagged))->n);
|
||||
}
|
||||
|
||||
FLOAT* ratio_to_float(CELL tagged)
|
||||
{
|
||||
RATIO* r = (RATIO*)UNTAG(tagged);
|
||||
return (FLOAT*)UNTAG(divfloat(r->numerator,r->denominator));
|
||||
}
|
||||
|
||||
void primitive_numberp(void)
|
||||
{
|
||||
check_non_empty(env.dt);
|
||||
|
@ -73,6 +89,7 @@ BINARY_OP(subtract, false, false)
|
|||
BINARY_OP(multiply, false, false)
|
||||
BINARY_OP(divide, false, false)
|
||||
BINARY_OP(divint, false, true)
|
||||
BINARY_OP(divfloat, false, false)
|
||||
BINARY_OP(divmod, false, true)
|
||||
BINARY_OP(mod, false, true)
|
||||
BINARY_OP(and, false, true)
|
||||
|
|
|
@ -2,52 +2,49 @@
|
|||
|
||||
BIGNUM* fixnum_to_bignum(CELL n);
|
||||
RATIO* fixnum_to_ratio(CELL n);
|
||||
FLOAT* fixnum_to_float(CELL n);
|
||||
FIXNUM bignum_to_fixnum(CELL tagged);
|
||||
RATIO* bignum_to_ratio(CELL n);
|
||||
FLOAT* bignum_to_float(CELL n);
|
||||
FLOAT* ratio_to_float(CELL n);
|
||||
|
||||
#define CELL_TO_INTEGER(result) \
|
||||
FIXNUM _result = (result); \
|
||||
if(_result < FIXNUM_MIN || _result > FIXNUM_MAX) \
|
||||
return tag_bignum(fixnum_to_bignum(_result)); \
|
||||
return tag_object(fixnum_to_bignum(_result)); \
|
||||
else \
|
||||
return tag_fixnum(_result);
|
||||
|
||||
#define BIGNUM_2_TO_INTEGER(result) \
|
||||
BIGNUM_2 _result = (result); \
|
||||
if(_result < FIXNUM_MIN || _result > FIXNUM_MAX) \
|
||||
return tag_bignum(bignum(_result)); \
|
||||
return tag_object(bignum(_result)); \
|
||||
else \
|
||||
return tag_fixnum(_result);
|
||||
|
||||
#define BINARY_OP(OP,anytype,integerOnly) \
|
||||
CELL OP(CELL x, CELL y) \
|
||||
{ \
|
||||
switch(TAG(x)) \
|
||||
switch(type_of(x)) \
|
||||
{ \
|
||||
case FIXNUM_TYPE: \
|
||||
\
|
||||
switch(TAG(y)) \
|
||||
switch(type_of(y)) \
|
||||
{ \
|
||||
case FIXNUM_TYPE: \
|
||||
return OP##_fixnum(x,y); \
|
||||
case OBJECT_TYPE: \
|
||||
switch(object_type(y)) \
|
||||
{ \
|
||||
case BIGNUM_TYPE: \
|
||||
return OP##_bignum((CELL)fixnum_to_bignum(x),y); \
|
||||
default: \
|
||||
if(anytype) \
|
||||
return OP##_anytype(x,y); \
|
||||
else \
|
||||
type_error(FIXNUM_TYPE,y); \
|
||||
return F; \
|
||||
} \
|
||||
break; \
|
||||
case RATIO_TYPE: \
|
||||
if(integerOnly) \
|
||||
return OP(x,to_integer(y)); \
|
||||
else \
|
||||
return OP##_ratio((CELL)fixnum_to_ratio(x),y); \
|
||||
case BIGNUM_TYPE: \
|
||||
return OP##_bignum((CELL)fixnum_to_bignum(x),y); \
|
||||
case FLOAT_TYPE: \
|
||||
if(integerOnly) \
|
||||
return OP(x,to_integer(y)); \
|
||||
else \
|
||||
return OP##_float((CELL)fixnum_to_float(x),y); \
|
||||
default: \
|
||||
if(anytype) \
|
||||
return OP##_anytype(x,y); \
|
||||
|
@ -55,67 +52,31 @@ CELL OP(CELL x, CELL y) \
|
|||
type_error(FIXNUM_TYPE,y); \
|
||||
return F; \
|
||||
} \
|
||||
\
|
||||
case OBJECT_TYPE: \
|
||||
\
|
||||
switch(object_type(x)) \
|
||||
{ \
|
||||
\
|
||||
case BIGNUM_TYPE: \
|
||||
\
|
||||
switch(TAG(y)) \
|
||||
{ \
|
||||
case FIXNUM_TYPE: \
|
||||
return OP##_bignum(x,(CELL)fixnum_to_bignum(y)); \
|
||||
case OBJECT_TYPE: \
|
||||
\
|
||||
switch(object_type(y)) \
|
||||
{ \
|
||||
case BIGNUM_TYPE: \
|
||||
return OP##_bignum(x,y); \
|
||||
default: \
|
||||
type_error(BIGNUM_TYPE,y); \
|
||||
return F; \
|
||||
} \
|
||||
case RATIO_TYPE: \
|
||||
if(integerOnly) \
|
||||
return OP(x,to_integer(y)); \
|
||||
else \
|
||||
return OP##_ratio((CELL)bignum_to_ratio(x),y); \
|
||||
default: \
|
||||
if(anytype) \
|
||||
return OP##_anytype(x,y); \
|
||||
else \
|
||||
type_error(BIGNUM_TYPE,y); \
|
||||
return F; \
|
||||
} \
|
||||
\
|
||||
default: \
|
||||
\
|
||||
if(anytype) \
|
||||
return OP##_anytype(x,y); \
|
||||
else \
|
||||
type_error(FIXNUM_TYPE,x); \
|
||||
return F; \
|
||||
} \
|
||||
\
|
||||
case RATIO_TYPE: \
|
||||
\
|
||||
switch(TAG(y)) \
|
||||
switch(type_of(y)) \
|
||||
{ \
|
||||
case FIXNUM_TYPE: \
|
||||
if(integerOnly) \
|
||||
return OP(to_integer(x),y); \
|
||||
else \
|
||||
return OP##_ratio(x,(CELL)fixnum_to_ratio(y)); \
|
||||
case OBJECT_TYPE: \
|
||||
switch(object_type(y)) \
|
||||
{ \
|
||||
case RATIO_TYPE: \
|
||||
if(integerOnly) \
|
||||
return OP(to_integer(x),to_integer(y)); \
|
||||
else \
|
||||
return OP##_ratio(x,y); \
|
||||
case BIGNUM_TYPE: \
|
||||
if(integerOnly) \
|
||||
return OP(to_integer(x),y); \
|
||||
else \
|
||||
return OP##_ratio(x,(CELL)bignum_to_ratio(y)); \
|
||||
case FLOAT_TYPE: \
|
||||
if(integerOnly) \
|
||||
return OP(to_integer(x),to_integer(y)); \
|
||||
else \
|
||||
return OP##_float((CELL)ratio_to_float(x),y); \
|
||||
default: \
|
||||
if(anytype) \
|
||||
return OP##_anytype(x,y); \
|
||||
|
@ -123,17 +84,62 @@ CELL OP(CELL x, CELL y) \
|
|||
type_error(FIXNUM_TYPE,y); \
|
||||
return F; \
|
||||
} \
|
||||
break; \
|
||||
\
|
||||
case BIGNUM_TYPE: \
|
||||
\
|
||||
switch(type_of(y)) \
|
||||
{ \
|
||||
case FIXNUM_TYPE: \
|
||||
return OP##_bignum(x,(CELL)fixnum_to_bignum(y)); \
|
||||
case RATIO_TYPE: \
|
||||
if(integerOnly) \
|
||||
return OP(to_integer(x),to_integer(y)); \
|
||||
return OP(x,to_integer(y)); \
|
||||
else \
|
||||
return OP##_ratio(x,y); \
|
||||
return OP##_ratio((CELL)bignum_to_ratio(x),y); \
|
||||
case BIGNUM_TYPE: \
|
||||
return OP##_bignum(x,y); \
|
||||
case FLOAT_TYPE: \
|
||||
if(integerOnly) \
|
||||
return OP(x,to_integer(y)); \
|
||||
else \
|
||||
return OP##_float((CELL)bignum_to_float(x),y); \
|
||||
default: \
|
||||
if(anytype) \
|
||||
return OP##_anytype(x,y); \
|
||||
else \
|
||||
type_error(FIXNUM_TYPE,y); \
|
||||
type_error(BIGNUM_TYPE,y); \
|
||||
return F; \
|
||||
} \
|
||||
\
|
||||
case FLOAT_TYPE: \
|
||||
\
|
||||
switch(type_of(y)) \
|
||||
{ \
|
||||
case FIXNUM_TYPE: \
|
||||
if(integerOnly) \
|
||||
return OP(to_integer(x),y); \
|
||||
else \
|
||||
return OP##_float(x,(CELL)fixnum_to_float(y)); \
|
||||
case RATIO_TYPE: \
|
||||
if(integerOnly) \
|
||||
return OP(x,to_integer(y)); \
|
||||
else \
|
||||
return OP##_float(x,(CELL)ratio_to_float(y)); \
|
||||
case BIGNUM_TYPE: \
|
||||
if(integerOnly) \
|
||||
return OP(to_integer(x),y); \
|
||||
else \
|
||||
return OP##_float(x,(CELL)bignum_to_float(y)); \
|
||||
case FLOAT_TYPE: \
|
||||
if(integerOnly) \
|
||||
return OP(to_integer(x),to_integer(y)); \
|
||||
else \
|
||||
return OP##_float(x,y); \
|
||||
default: \
|
||||
if(anytype) \
|
||||
return OP##_anytype(x,y); \
|
||||
else \
|
||||
type_error(FLOAT_TYPE,y); \
|
||||
return F; \
|
||||
} \
|
||||
\
|
||||
|
@ -157,16 +163,12 @@ void primitive_numberp(void);
|
|||
|
||||
FIXNUM to_fixnum(CELL tagged);
|
||||
void primitive_to_fixnum(void);
|
||||
|
||||
BIGNUM* to_bignum(CELL tagged);
|
||||
void primitive_to_bignum(void);
|
||||
|
||||
CELL to_integer(CELL tagged);
|
||||
void primitive_to_integer(void);
|
||||
|
||||
CELL number_eq(CELL x, CELL y);
|
||||
void primitive_number_eq(void);
|
||||
|
||||
CELL add(CELL x, CELL y);
|
||||
void primitive_add(void);
|
||||
CELL subtract(CELL x, CELL y);
|
||||
|
@ -177,14 +179,27 @@ CELL divide(CELL x, CELL y);
|
|||
void primitive_divmod(void);
|
||||
CELL divint(CELL x, CELL y);
|
||||
void primitive_divint(void);
|
||||
CELL divfloat(CELL x, CELL y);
|
||||
void primitive_divfloat(void);
|
||||
CELL divide(CELL x, CELL y);
|
||||
void primitive_divide(void);
|
||||
CELL less(CELL x, CELL y);
|
||||
void primitive_less(void);
|
||||
CELL lesseq(CELL x, CELL y);
|
||||
void primitive_lesseq(void);
|
||||
CELL greater(CELL x, CELL y);
|
||||
void primitive_greater(void);
|
||||
CELL greatereq(CELL x, CELL y);
|
||||
void primitive_greatereq(void);
|
||||
CELL mod(CELL x, CELL y);
|
||||
void primitive_mod(void);
|
||||
CELL and(CELL x, CELL y);
|
||||
void primitive_and(void);
|
||||
CELL or(CELL x, CELL y);
|
||||
void primitive_or(void);
|
||||
CELL xor(CELL x, CELL y);
|
||||
void primitive_xor(void);
|
||||
CELL shiftleft(CELL x, CELL y);
|
||||
void primitive_shiftleft(void);
|
||||
CELL shiftright(CELL x, CELL y);
|
||||
void primitive_shiftright(void);
|
||||
|
|
|
@ -3,7 +3,7 @@
|
|||
/* untagged */
|
||||
ARRAY* allot_array(CELL capacity)
|
||||
{
|
||||
ARRAY* array = (ARRAY*)allot_object(ARRAY_TYPE,
|
||||
ARRAY* array = allot_object(ARRAY_TYPE,
|
||||
sizeof(ARRAY) + capacity * CELLS);
|
||||
array->capacity = capacity;
|
||||
return array;
|
||||
|
|
|
@ -9,6 +9,7 @@ void primitive_bignump(void)
|
|||
BIGNUM* to_bignum(CELL tagged)
|
||||
{
|
||||
RATIO* r;
|
||||
FLOAT* f;
|
||||
|
||||
switch(type_of(tagged))
|
||||
{
|
||||
|
@ -19,6 +20,9 @@ BIGNUM* to_bignum(CELL tagged)
|
|||
case RATIO_TYPE:
|
||||
r = (RATIO*)UNTAG(tagged);
|
||||
return to_bignum(divint(r->numerator,r->denominator));
|
||||
case FLOAT_TYPE:
|
||||
f = (FLOAT*)UNTAG(tagged);
|
||||
return bignum((BIGNUM_2)f->n);
|
||||
default:
|
||||
type_error(BIGNUM_TYPE,tagged);
|
||||
return NULL; /* can't happen */
|
||||
|
@ -27,7 +31,7 @@ BIGNUM* to_bignum(CELL tagged)
|
|||
|
||||
void primitive_to_bignum(void)
|
||||
{
|
||||
env.dt = tag_bignum(to_bignum(env.dt));
|
||||
env.dt = tag_object(to_bignum(env.dt));
|
||||
}
|
||||
|
||||
CELL number_eq_bignum(CELL x, CELL y)
|
||||
|
@ -110,8 +114,8 @@ CELL divide_bignum(CELL x, CELL y)
|
|||
else
|
||||
{
|
||||
return tag_ratio(ratio(
|
||||
tag_bignum(bignum(_x)),
|
||||
tag_bignum(bignum(_y))));
|
||||
tag_object(bignum(_x)),
|
||||
tag_object(bignum(_y))));
|
||||
}
|
||||
}
|
||||
|
||||
|
@ -121,6 +125,13 @@ CELL divint_bignum(CELL x, CELL y)
|
|||
/ ((BIGNUM*)UNTAG(y))->n));
|
||||
}
|
||||
|
||||
CELL divfloat_bignum(CELL x, CELL y)
|
||||
{
|
||||
BIGNUM_2 _x = ((BIGNUM*)UNTAG(x))->n;
|
||||
BIGNUM_2 _y = ((BIGNUM*)UNTAG(y))->n;
|
||||
return tag_object(make_float((double)_x / (double)_y));
|
||||
}
|
||||
|
||||
CELL divmod_bignum(CELL x, CELL y)
|
||||
{
|
||||
dpush(tag_object(bignum(((BIGNUM*)UNTAG(x))->n
|
||||
|
|
|
@ -8,7 +8,7 @@ typedef struct {
|
|||
/* untagged */
|
||||
INLINE BIGNUM* allot_bignum()
|
||||
{
|
||||
return (BIGNUM*)allot_object(BIGNUM_TYPE,sizeof(BIGNUM));
|
||||
return allot_object(BIGNUM_TYPE,sizeof(BIGNUM));
|
||||
}
|
||||
|
||||
/* untagged */
|
||||
|
@ -25,11 +25,6 @@ INLINE BIGNUM* untag_bignum(CELL tagged)
|
|||
return (BIGNUM*)UNTAG(tagged);
|
||||
}
|
||||
|
||||
INLINE CELL tag_bignum(BIGNUM* untagged)
|
||||
{
|
||||
return RETAG(untagged,OBJECT_TYPE);
|
||||
}
|
||||
|
||||
void primitive_bignump(void);
|
||||
BIGNUM* to_bignum(CELL tagged);
|
||||
void primitive_to_bignum(void);
|
||||
|
@ -40,6 +35,7 @@ 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 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);
|
||||
|
|
|
@ -46,6 +46,7 @@ typedef unsigned char BYTE;
|
|||
#include "fixnum.h"
|
||||
#include "bignum.h"
|
||||
#include "ratio.h"
|
||||
#include "float.h"
|
||||
#include "arithmetic.h"
|
||||
#include "misc.h"
|
||||
#include "string.h"
|
||||
|
|
|
@ -15,6 +15,7 @@ void primitive_not(void)
|
|||
FIXNUM to_fixnum(CELL tagged)
|
||||
{
|
||||
RATIO* r;
|
||||
FLOAT* f;
|
||||
|
||||
switch(type_of(tagged))
|
||||
{
|
||||
|
@ -25,6 +26,9 @@ FIXNUM to_fixnum(CELL tagged)
|
|||
case RATIO_TYPE:
|
||||
r = (RATIO*)UNTAG(tagged);
|
||||
return to_fixnum(divint(r->numerator,r->denominator));
|
||||
case FLOAT_TYPE:
|
||||
f = (FLOAT*)UNTAG(tagged);
|
||||
return (FIXNUM)f->n;
|
||||
default:
|
||||
type_error(FIXNUM_TYPE,tagged);
|
||||
return -1; /* can't happen */
|
||||
|
@ -60,7 +64,17 @@ CELL multiply_fixnum(CELL x, CELL y)
|
|||
CELL divint_fixnum(CELL x, CELL y)
|
||||
{
|
||||
/* division takes common factor of 8 out. */
|
||||
return tag_fixnum(x / y);
|
||||
/* we have to do SIGNED division here */
|
||||
return tag_fixnum((FIXNUM)x / (FIXNUM)y);
|
||||
}
|
||||
|
||||
CELL divfloat_fixnum(CELL x, CELL y)
|
||||
{
|
||||
/* division takes common factor of 8 out. */
|
||||
/* we have to do SIGNED division here */
|
||||
FIXNUM _x = (FIXNUM)x;
|
||||
FIXNUM _y = (FIXNUM)y;
|
||||
return tag_object(make_float((double)_x / (double)_y));
|
||||
}
|
||||
|
||||
CELL divmod_fixnum(CELL x, CELL y)
|
||||
|
@ -107,6 +121,7 @@ CELL divide_fixnum(CELL x, CELL y)
|
|||
{
|
||||
FIXNUM _x = untag_fixnum_fast(x);
|
||||
FIXNUM _y = untag_fixnum_fast(y);
|
||||
FIXNUM gcd;
|
||||
|
||||
if(_y == 0)
|
||||
{
|
||||
|
@ -119,7 +134,7 @@ CELL divide_fixnum(CELL x, CELL y)
|
|||
_y = -_y;
|
||||
}
|
||||
|
||||
FIXNUM gcd = gcd_fixnum(_x,_y);
|
||||
gcd = gcd_fixnum(_x,_y);
|
||||
if(gcd != 1)
|
||||
{
|
||||
_x /= gcd;
|
||||
|
|
|
@ -26,6 +26,7 @@ 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 divfloat_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);
|
||||
|
|
|
@ -0,0 +1,90 @@
|
|||
#include "factor.h"
|
||||
|
||||
void primitive_floatp(void)
|
||||
{
|
||||
check_non_empty(env.dt);
|
||||
env.dt = tag_boolean(typep(FLOAT_TYPE,env.dt));
|
||||
}
|
||||
|
||||
FLOAT* to_float(CELL tagged)
|
||||
{
|
||||
switch(type_of(tagged))
|
||||
{
|
||||
case FIXNUM_TYPE:
|
||||
return fixnum_to_float(tagged);
|
||||
case BIGNUM_TYPE:
|
||||
return bignum_to_float(tagged);
|
||||
case RATIO_TYPE:
|
||||
return ratio_to_float(tagged);
|
||||
case FLOAT_TYPE:
|
||||
return (FLOAT*)UNTAG(tagged);
|
||||
default:
|
||||
type_error(FLOAT_TYPE,tagged);
|
||||
return NULL; /* can't happen */
|
||||
}
|
||||
}
|
||||
|
||||
void primitive_to_float(void)
|
||||
{
|
||||
env.dt = tag_object(to_float(env.dt));
|
||||
}
|
||||
|
||||
CELL number_eq_float(CELL x, CELL y)
|
||||
{
|
||||
return tag_boolean(((FLOAT*)UNTAG(x))->n
|
||||
== ((FLOAT*)UNTAG(y))->n);
|
||||
}
|
||||
|
||||
CELL add_float(CELL x, CELL y)
|
||||
{
|
||||
return tag_object(make_float(((FLOAT*)UNTAG(x))->n
|
||||
+ ((FLOAT*)UNTAG(y))->n));
|
||||
}
|
||||
|
||||
CELL subtract_float(CELL x, CELL y)
|
||||
{
|
||||
return tag_object(make_float(((FLOAT*)UNTAG(x))->n
|
||||
- ((FLOAT*)UNTAG(y))->n));
|
||||
}
|
||||
|
||||
CELL multiply_float(CELL x, CELL y)
|
||||
{
|
||||
return tag_object(make_float(((FLOAT*)UNTAG(x))->n
|
||||
* ((FLOAT*)UNTAG(y))->n));
|
||||
}
|
||||
|
||||
CELL divide_float(CELL x, CELL y)
|
||||
{
|
||||
return tag_object(make_float(((FLOAT*)UNTAG(x))->n
|
||||
/ ((FLOAT*)UNTAG(y))->n));
|
||||
}
|
||||
|
||||
CELL divfloat_float(CELL x, CELL y)
|
||||
{
|
||||
return tag_object(make_float(((FLOAT*)UNTAG(x))->n
|
||||
/ ((FLOAT*)UNTAG(y))->n));
|
||||
}
|
||||
|
||||
CELL less_float(CELL x, CELL y)
|
||||
{
|
||||
return tag_boolean(((FLOAT*)UNTAG(x))->n
|
||||
< ((FLOAT*)UNTAG(y))->n);
|
||||
}
|
||||
|
||||
CELL lesseq_float(CELL x, CELL y)
|
||||
{
|
||||
return tag_boolean(((FLOAT*)UNTAG(x))->n
|
||||
<= ((FLOAT*)UNTAG(y))->n);
|
||||
}
|
||||
|
||||
CELL greater_float(CELL x, CELL y)
|
||||
{
|
||||
return tag_boolean(((FLOAT*)UNTAG(x))->n
|
||||
> ((FLOAT*)UNTAG(y))->n);
|
||||
}
|
||||
|
||||
CELL greatereq_float(CELL x, CELL y)
|
||||
{
|
||||
return tag_boolean(((FLOAT*)UNTAG(x))->n
|
||||
>= ((FLOAT*)UNTAG(y))->n);
|
||||
}
|
|
@ -0,0 +1,31 @@
|
|||
typedef struct {
|
||||
CELL header;
|
||||
double n;
|
||||
} FLOAT;
|
||||
|
||||
INLINE FLOAT* make_float(double n)
|
||||
{
|
||||
FLOAT* flo = allot_object(FLOAT_TYPE,sizeof(FLOAT));
|
||||
flo->n = n;
|
||||
return flo;
|
||||
}
|
||||
|
||||
INLINE FLOAT* untag_float(CELL tagged)
|
||||
{
|
||||
type_check(FLOAT_TYPE,tagged);
|
||||
return (FLOAT*)UNTAG(tagged);
|
||||
}
|
||||
|
||||
void primitive_floatp(void);
|
||||
FLOAT* to_float(CELL tagged);
|
||||
void primitive_to_float(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);
|
|
@ -15,7 +15,7 @@ HANDLE* untag_handle(CELL type, CELL tagged)
|
|||
|
||||
CELL handle(CELL type, CELL object)
|
||||
{
|
||||
HANDLE* handle = (HANDLE*)allot_object(HANDLE_TYPE,sizeof(HANDLE));
|
||||
HANDLE* handle = allot_object(HANDLE_TYPE,sizeof(HANDLE));
|
||||
handle->type = type;
|
||||
handle->object = object;
|
||||
handle->buffer = F;
|
||||
|
|
|
@ -93,22 +93,43 @@ CELL divide_ratio(CELL x, CELL y)
|
|||
multiply(rx->denominator,ry->numerator));
|
||||
}
|
||||
|
||||
CELL divfloat_ratio(CELL x, CELL y)
|
||||
{
|
||||
RATIO* rx = (RATIO*)UNTAG(x);
|
||||
RATIO* ry = (RATIO*)UNTAG(y);
|
||||
return divfloat(
|
||||
multiply(rx->numerator,ry->denominator),
|
||||
multiply(rx->denominator,ry->numerator));
|
||||
}
|
||||
|
||||
CELL less_ratio(CELL x, CELL y)
|
||||
{
|
||||
return F;
|
||||
RATIO* rx = (RATIO*)UNTAG(x);
|
||||
RATIO* ry = (RATIO*)UNTAG(y);
|
||||
return less(multiply(rx->numerator,ry->denominator),
|
||||
multiply(ry->numerator,rx->denominator));
|
||||
}
|
||||
|
||||
CELL lesseq_ratio(CELL x, CELL y)
|
||||
{
|
||||
return F;
|
||||
RATIO* rx = (RATIO*)UNTAG(x);
|
||||
RATIO* ry = (RATIO*)UNTAG(y);
|
||||
return lesseq(multiply(rx->numerator,ry->denominator),
|
||||
multiply(ry->numerator,rx->denominator));
|
||||
}
|
||||
|
||||
CELL greater_ratio(CELL x, CELL y)
|
||||
{
|
||||
return F;
|
||||
RATIO* rx = (RATIO*)UNTAG(x);
|
||||
RATIO* ry = (RATIO*)UNTAG(y);
|
||||
return greater(multiply(rx->numerator,ry->denominator),
|
||||
multiply(ry->numerator,rx->denominator));
|
||||
}
|
||||
|
||||
CELL greatereq_ratio(CELL x, CELL y)
|
||||
{
|
||||
return F;
|
||||
RATIO* rx = (RATIO*)UNTAG(x);
|
||||
RATIO* ry = (RATIO*)UNTAG(y);
|
||||
return greatereq(multiply(rx->numerator,ry->denominator),
|
||||
multiply(ry->numerator,rx->denominator));
|
||||
}
|
||||
|
|
|
@ -24,6 +24,7 @@ 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);
|
||||
|
|
|
@ -2,7 +2,7 @@
|
|||
|
||||
SBUF* sbuf(FIXNUM capacity)
|
||||
{
|
||||
SBUF* sbuf = (SBUF*)allot_object(SBUF_TYPE,sizeof(SBUF));
|
||||
SBUF* sbuf = allot_object(SBUF_TYPE,sizeof(SBUF));
|
||||
sbuf->top = 0;
|
||||
sbuf->string = string(capacity,'\0');
|
||||
return sbuf;
|
||||
|
|
|
@ -3,7 +3,7 @@
|
|||
/* untagged */
|
||||
STRING* allot_string(CELL capacity)
|
||||
{
|
||||
STRING* string = (STRING*)allot_object(STRING_TYPE,
|
||||
STRING* string = allot_object(STRING_TYPE,
|
||||
sizeof(STRING) + capacity * CHARS);
|
||||
string->capacity = capacity;
|
||||
return string;
|
||||
|
|
|
@ -51,11 +51,11 @@ void type_check(CELL type, CELL tagged)
|
|||
* It is up to the caller to fill in the object's fields in a meaningful
|
||||
* fashion!
|
||||
*/
|
||||
CELL allot_object(CELL type, CELL length)
|
||||
void* allot_object(CELL type, CELL length)
|
||||
{
|
||||
CELL* object = allot(length);
|
||||
*object = tag_header(type);
|
||||
return (CELL)object;
|
||||
return object;
|
||||
}
|
||||
|
||||
CELL object_size(CELL pointer)
|
||||
|
|
|
@ -33,6 +33,7 @@ CELL empty;
|
|||
#define SBUF_TYPE 12
|
||||
#define HANDLE_TYPE 13
|
||||
#define BIGNUM_TYPE 14
|
||||
#define FLOAT_TYPE 15
|
||||
|
||||
bool typep(CELL type, CELL tagged);
|
||||
CELL type_of(CELL tagged);
|
||||
|
@ -77,6 +78,6 @@ INLINE CELL object_type(CELL tagged)
|
|||
return untag_header(get(UNTAG(tagged)));
|
||||
}
|
||||
|
||||
CELL allot_object(CELL type, CELL length);
|
||||
void* allot_object(CELL type, CELL length);
|
||||
CELL untagged_object_size(CELL pointer);
|
||||
CELL object_size(CELL pointer);
|
||||
|
|
|
@ -2,7 +2,7 @@
|
|||
|
||||
VECTOR* vector(FIXNUM capacity)
|
||||
{
|
||||
VECTOR* vector = (VECTOR*)allot_object(VECTOR_TYPE,sizeof(VECTOR));
|
||||
VECTOR* vector = allot_object(VECTOR_TYPE,sizeof(VECTOR));
|
||||
vector->top = 0;
|
||||
vector->array = array(capacity,F);
|
||||
return vector;
|
||||
|
|
|
@ -2,7 +2,7 @@
|
|||
|
||||
WORD* word(CELL primitive, CELL parameter, CELL plist)
|
||||
{
|
||||
WORD* word = (WORD*)allot_object(WORD_TYPE,sizeof(WORD));
|
||||
WORD* word = allot_object(WORD_TYPE,sizeof(WORD));
|
||||
word->xt = primitive_to_xt(primitive);
|
||||
word->primitive = primitive;
|
||||
word->parameter = parameter;
|
||||
|
|
Loading…
Reference in New Issue