factor/native/fixnum.c

#include "factor.h"

F_FIXNUM to_fixnum(CELL tagged)
{
	F_RATIO* r;
	F_ARRAY* x;
	F_ARRAY* y;
	F_FLOAT* f;

	switch(type_of(tagged))
	{
	case FIXNUM_TYPE:
		return untag_fixnum_fast(tagged);
	case BIGNUM_TYPE:
		return (F_FIXNUM)s48_bignum_to_long((F_ARRAY*)UNTAG(tagged));
	case RATIO_TYPE:
		r = (F_RATIO*)UNTAG(tagged);
		x = to_bignum(r->numerator);
		y = to_bignum(r->denominator);
		return to_fixnum(tag_object(s48_bignum_quotient(x,y)));
	case FLOAT_TYPE:
		f = (F_FLOAT*)UNTAG(tagged);
		return (F_FIXNUM)f->n;
	default:
		type_error(FIXNUM_TYPE,tagged);
		return -1; /* can't happen */
	}
}

void primitive_to_fixnum(void)
{
	drepl(tag_fixnum(to_fixnum(dpeek())));
}

void primitive_fixnum_eq(void)
{
	F_FIXNUM y = untag_fixnum_fast(dpop());
	F_FIXNUM x = untag_fixnum_fast(dpop());
	box_boolean(x == y);
}

void primitive_fixnum_add(void)
{
	F_FIXNUM y = untag_fixnum_fast(dpop());
	F_FIXNUM x = untag_fixnum_fast(dpop());
	box_integer(x + y);
}

void primitive_fixnum_subtract(void)
{
	F_FIXNUM y = untag_fixnum_fast(dpop());
	F_FIXNUM x = untag_fixnum_fast(dpop());
	box_integer(x - y);
}

/**
 * Multiply two integers, and trap overflow.
 * Thanks to David Blaikie (The_Vulture from freenode #java) for the hint.
 */
void primitive_fixnum_multiply(void)
{
	F_FIXNUM y = untag_fixnum_fast(dpop());
	F_FIXNUM x = untag_fixnum_fast(dpop());

	if(x == 0 || y == 0)
		dpush(tag_fixnum(0));
	else
	{
		F_FIXNUM prod = x * y;
		/* if this is not equal, we have overflow */
		if(prod / x == y)
			box_integer(prod);
		else
		{
			dpush(tag_object(
				s48_bignum_multiply(
					s48_long_to_bignum(x),
					s48_long_to_bignum(y))));
		}
	}
}

void primitive_fixnum_divint(void)
{
	F_FIXNUM y = untag_fixnum_fast(dpop());
	F_FIXNUM x = untag_fixnum_fast(dpop());
	box_integer(x / y);
}

void primitive_fixnum_divfloat(void)
{
	F_FIXNUM y = untag_fixnum_fast(dpop());
	F_FIXNUM x = untag_fixnum_fast(dpop());
	dpush(tag_object(make_float((double)x / (double)y)));
}

void primitive_fixnum_divmod(void)
{
	F_FIXNUM y = untag_fixnum_fast(dpop());
	F_FIXNUM x = untag_fixnum_fast(dpop());
	box_integer(x / y);
	box_integer(x % y);
}

void primitive_fixnum_mod(void)
{
	F_FIXNUM y = untag_fixnum_fast(dpop());
	F_FIXNUM x = untag_fixnum_fast(dpop());
	dpush(tag_fixnum(x % y));
}

void primitive_fixnum_and(void)
{
	F_FIXNUM y = untag_fixnum_fast(dpop());
	F_FIXNUM x = untag_fixnum_fast(dpop());
	dpush(tag_fixnum(x & y));
}

void primitive_fixnum_or(void)
{
	F_FIXNUM y = untag_fixnum_fast(dpop());
	F_FIXNUM x = untag_fixnum_fast(dpop());
	dpush(tag_fixnum(x | y));
}

void primitive_fixnum_xor(void)
{
	F_FIXNUM y = untag_fixnum_fast(dpop());
	F_FIXNUM x = untag_fixnum_fast(dpop());
	dpush(tag_fixnum(x ^ y));
}

/*
 * Note the hairy overflow check.
 * If we're shifting right by n bits, we won't overflow as long as none of the
 * high WORD_SIZE-TAG_BITS-n bits are set.
 */
void primitive_fixnum_shift(void)
{
	F_FIXNUM y = untag_fixnum_fast(dpop());
	F_FIXNUM x = untag_fixnum_fast(dpop());

	if(y < 0)
	{
		if(y <= -WORD_SIZE)
			dpush(x < 0 ? tag_fixnum(-1) : tag_fixnum(0));
		else
			dpush(tag_fixnum(x >> -y));
		return;
	}
	else if(y == 0)
	{
		dpush(tag_fixnum(x));
		return;
	}
	else if(y < WORD_SIZE - TAG_BITS)
	{
		F_FIXNUM mask = (1 << (WORD_SIZE - 1 - TAG_BITS - y));
		if(x > 0)
			mask = -mask;

		if((x & mask) == 0)
		{
			dpush(tag_fixnum(x << y));
			return;
		}
	}

	dpush(tag_object(s48_bignum_arithmetic_shift(
		s48_long_to_bignum(x),y)));
}

void primitive_fixnum_less(void)
{
	F_FIXNUM y = untag_fixnum_fast(dpop());
	F_FIXNUM x = untag_fixnum_fast(dpop());
	box_boolean(x < y);
}

void primitive_fixnum_lesseq(void)
{
	F_FIXNUM y = untag_fixnum_fast(dpop());
	F_FIXNUM x = untag_fixnum_fast(dpop());
	box_boolean(x <= y);
}

void primitive_fixnum_greater(void)
{
	F_FIXNUM y = untag_fixnum_fast(dpop());
	F_FIXNUM x = untag_fixnum_fast(dpop());
	box_boolean(x > y);
}

void primitive_fixnum_greatereq(void)
{
	F_FIXNUM y = untag_fixnum_fast(dpop());
	F_FIXNUM x = untag_fixnum_fast(dpop());
	box_boolean(x >= y);
}

void primitive_fixnum_not(void)
{
	drepl(tag_fixnum(~untag_fixnum_fast(dpeek())));
}

/* FFI calls this */
void box_signed_1(signed char integer)
{
	dpush(tag_integer(integer));
}

/* FFI calls this */
void box_signed_2(signed short integer)
{
	dpush(tag_integer(integer));
}

/* FFI calls this */
signed char unbox_signed_1(void)
{
	return to_integer(dpop());
}

/* FFI calls this */
signed short unbox_signed_2(void)
{
	return to_integer(dpop());
}