factor/native/arithmetic.h

#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);
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_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_object(bignum(_result)); \
        else \
                return tag_fixnum(_result);

#define BINARY_OP(OP) \
CELL OP(CELL x, CELL y) \
{ \
	switch(upgraded_arithmetic_type(type_of(x),type_of(y))) \
	{ \
	case FIXNUM_TYPE: \
		return OP##_fixnum(x,y); \
	case BIGNUM_TYPE: \
		return OP##_bignum(to_bignum(x),to_bignum(y)); \
	case RATIO_TYPE: \
		return OP##_ratio(to_ratio(x),to_ratio(y)); \
	case FLOAT_TYPE: \
		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); \
	} \
} \
\
void primitive_##OP(void) \
{ \
	CELL y = dpop(), x = dpop(); \
	dpush(OP(x,y)); \
}

#define BINARY_OP_INTEGER_ONLY(OP) \
\
CELL OP##_ratio(RATIO* x, RATIO* y) \
{ \
	type_error(INTEGER_TYPE,tag_ratio(x)); \
	return F; \
} \
\
CELL OP##_complex(COMPLEX* x, COMPLEX* y) \
{ \
	type_error(INTEGER_TYPE,tag_complex(x)); \
	return F; \
} \
\
CELL OP##_float(FLOAT* x, FLOAT* y) \
{ \
	type_error(INTEGER_TYPE,tag_object(x)); \
	return F; \
}

#define BINARY_OP_NUMBER_ONLY(OP) \
\
CELL OP##_anytype(CELL x, CELL y) \
{ \
	type_error(NUMBER_TYPE,x); \
	return F; \
}

#define UNARY_OP(OP) \
CELL OP(CELL x) \
{ \
	switch(type_of(x)) \
	{ \
	case FIXNUM_TYPE: \
		return OP##_fixnum(x); \
	case RATIO_TYPE: \
		return OP##_ratio((RATIO*)UNTAG(x)); \
	case COMPLEX_TYPE: \
		return OP##_complex((COMPLEX*)UNTAG(x)); \
	case BIGNUM_TYPE: \
		return OP##_bignum((BIGNUM*)UNTAG(x)); \
	case FLOAT_TYPE: \
		return OP##_float((FLOAT*)UNTAG(x)); \
	default: \
		return OP##_anytype(x); \
	} \
} \
\
void primitive_##OP(void) \
{ \
	drepl(OP(dpeek())); \
}

#define UNARY_OP_INTEGER_ONLY(OP) \
\
CELL OP##_ratio(RATIO* x) \
{ \
	type_error(INTEGER_TYPE,tag_ratio(x)); \
	return F; \
} \
\
CELL OP##_complex(COMPLEX* x) \
{ \
	type_error(INTEGER_TYPE,tag_complex(x)); \
	return F; \
} \
\
CELL OP##_float(FLOAT* x) \
{ \
	type_error(INTEGER_TYPE,tag_object(x)); \
	return F; \
}

#define UNARY_OP_NUMBER_ONLY(OP) \
\
CELL OP##_anytype(CELL x) \
{ \
	type_error(NUMBER_TYPE,x); \
	return F; \
}

bool realp(CELL tagged);
bool numberp(CELL tagged);
void primitive_numberp(void);

bool zerop(CELL tagged);

FIXNUM to_fixnum(CELL tagged);
void primitive_to_fixnum(void);
BIGNUM* to_bignum(CELL tagged);
void primitive_to_bignum(void);
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);
void primitive_subtract(void);
CELL multiply(CELL x, CELL y);
void primitive_multiply(void);
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);
CELL gcd(CELL x, CELL y);
void primitive_gcd(void);