187 lines
2.9 KiB
C
187 lines
2.9 KiB
C
#include "factor.h"
|
|
|
|
CELL tag_integer(FIXNUM x)
|
|
{
|
|
if(x < FIXNUM_MIN || x > FIXNUM_MAX)
|
|
return tag_object(s48_long_to_bignum(x));
|
|
else
|
|
return tag_fixnum(x);
|
|
}
|
|
|
|
CELL tag_cell(CELL x)
|
|
{
|
|
if(x > FIXNUM_MAX)
|
|
return tag_object(s48_ulong_to_bignum(x));
|
|
else
|
|
return tag_fixnum(x);
|
|
}
|
|
|
|
CELL to_cell(CELL x)
|
|
{
|
|
switch(type_of(x))
|
|
{
|
|
case FIXNUM_TYPE:
|
|
return untag_fixnum_fast(x);
|
|
case BIGNUM_TYPE:
|
|
/* really need bignum_to_ulong! */
|
|
return s48_bignum_to_long(untag_bignum(x));
|
|
default:
|
|
type_error(INTEGER_TYPE,x);
|
|
}
|
|
}
|
|
|
|
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;
|
|
}
|
|
}
|
|
|
|
bool realp(CELL tagged)
|
|
{
|
|
switch(type_of(tagged))
|
|
{
|
|
case FIXNUM_TYPE:
|
|
case BIGNUM_TYPE:
|
|
case RATIO_TYPE:
|
|
case FLOAT_TYPE:
|
|
return true;
|
|
break;
|
|
default:
|
|
return false;
|
|
break;
|
|
}
|
|
}
|
|
|
|
void primitive_numberp(void)
|
|
{
|
|
CELL tagged = dpeek();
|
|
drepl(tag_boolean(realp(tagged) || type_of(tagged) == COMPLEX_TYPE));
|
|
}
|
|
|
|
bool zerop(CELL tagged)
|
|
{
|
|
switch(type_of(tagged))
|
|
{
|
|
case FIXNUM_TYPE:
|
|
return tagged == 0;
|
|
case BIGNUM_TYPE:
|
|
return BIGNUM_ZERO_P((ARRAY*)UNTAG(tagged));
|
|
case FLOAT_TYPE:
|
|
return ((FLOAT*)UNTAG(tagged))->n == 0.0;
|
|
case RATIO_TYPE:
|
|
return false;
|
|
default:
|
|
critical_error("Bad parameter to zerop",tagged);
|
|
return false; /* Can't happen */
|
|
}
|
|
}
|
|
|
|
/* EQUALITY */
|
|
CELL number_eq_anytype(CELL x, CELL y)
|
|
{
|
|
return F;
|
|
}
|
|
|
|
|
|
BINARY_OP(number_eq)
|
|
|
|
BINARY_OP_NUMBER_ONLY(add)
|
|
BINARY_OP(add)
|
|
|
|
BINARY_OP_NUMBER_ONLY(subtract)
|
|
BINARY_OP(subtract)
|
|
|
|
BINARY_OP_NUMBER_ONLY(multiply)
|
|
BINARY_OP(multiply)
|
|
|
|
BINARY_OP_NUMBER_ONLY(divide)
|
|
BINARY_OP(divide)
|
|
|
|
BINARY_OP_INTEGER_ONLY(divint)
|
|
BINARY_OP_NUMBER_ONLY(divint)
|
|
BINARY_OP(divint)
|
|
|
|
BINARY_OP_NUMBER_ONLY(divfloat)
|
|
BINARY_OP(divfloat)
|
|
|
|
BINARY_OP_INTEGER_ONLY(divmod)
|
|
BINARY_OP_NUMBER_ONLY(divmod)
|
|
BINARY_OP(divmod)
|
|
|
|
BINARY_OP_INTEGER_ONLY(mod)
|
|
BINARY_OP_NUMBER_ONLY(mod)
|
|
BINARY_OP(mod)
|
|
|
|
BINARY_OP_INTEGER_ONLY(and)
|
|
BINARY_OP_NUMBER_ONLY(and)
|
|
BINARY_OP(and)
|
|
|
|
BINARY_OP_INTEGER_ONLY(or)
|
|
BINARY_OP_NUMBER_ONLY(or)
|
|
BINARY_OP(or)
|
|
|
|
BINARY_OP_INTEGER_ONLY(xor)
|
|
BINARY_OP_NUMBER_ONLY(xor)
|
|
BINARY_OP(xor)
|
|
|
|
BINARY_OP_FIXNUM(shift)
|
|
|
|
BINARY_OP_NUMBER_ONLY(less)
|
|
BINARY_OP(less)
|
|
|
|
BINARY_OP_NUMBER_ONLY(lesseq)
|
|
BINARY_OP(lesseq)
|
|
|
|
BINARY_OP_NUMBER_ONLY(greater)
|
|
BINARY_OP(greater)
|
|
|
|
BINARY_OP_NUMBER_ONLY(greatereq)
|
|
BINARY_OP(greatereq)
|
|
|
|
UNARY_OP_INTEGER_ONLY(not)
|
|
UNARY_OP_NUMBER_ONLY(not)
|
|
UNARY_OP(not)
|