OBJECT float_coerce(STATE, OBJECT value) {
if(FIXNUM_P(value)) {
return float_new(state, (double)N2I(value));
} else if(BIGNUM_P(value)) {
return float_new(state, bignum_to_double(state, value));
}
return value;
}
inline double factor_vm::bignum_to_float(cell tagged)
{
return bignum_to_double(untag<bignum>(tagged));
}
int are_terms_equal(term_t a, term_t b, int exact)
{
assert(a != b); // should be checked elsewhere
if (is_immed(a) || is_immed(b))
{
if (exact)
return 0;
if (is_int(a) && is_boxed(b))
{
uint32_t *term_data = peel_boxed(b);
return (boxed_tag(term_data) == SUBTAG_FLOAT)
&& (double)int_value(a) == float_value(term_data);
}
else if (is_boxed(a) && is_int(b))
{
uint32_t *term_data = peel_boxed(a);
return (boxed_tag(term_data) == SUBTAG_FLOAT)
&& (float_value(term_data) == (double)int_value(b));
}
return 0;
}
if (is_cons(a))
{
if (is_cons(b))
{
do {
uint32_t *cons1 = peel_cons(a);
uint32_t *cons2 = peel_cons(b);
if (cons1[0] != cons2[0]
&& !are_terms_equal(cons1[0], cons2[0], exact))
return 0;
a = cons1[1];
b = cons2[1];
} while (is_cons(a) && is_cons(b));
return (a == b) || are_terms_equal(a, b, exact);
}
else
return 0;
}
else if (is_tuple(a))
{
if (is_tuple(b))
{
uint32_t *data1 = peel_tuple(a);
uint32_t *data2 = peel_tuple(b);
if (data1[0] != data2[0])
return 0;
for (int i = 1; i <= data1[0]; i++)
if (data1[i] != data2[i]
&& !are_terms_equal(data1[i], data2[i], exact))
return 0;
return 1;
}
else
return 0;
}
else
{
assert(is_boxed(a));
if (!is_boxed(b))
return 0;
uint32_t *term_data1 = peel_boxed(a);
uint32_t *term_data2 = peel_boxed(b);
uint32_t subtag = boxed_tag(term_data1);
if (!exact && subtag == SUBTAG_FLOAT && is_bignum(term_data2))
return float_value(term_data1) == bignum_to_double((bignum_t *)term_data2);
if (!exact && is_bignum(term_data1) && boxed_tag(term_data2) == SUBTAG_FLOAT)
return bignum_to_double((bignum_t *)term_data1) == float_value(term_data2);
if (subtag != boxed_tag(term_data2) &&
!(is_binary(term_data1) && is_binary(term_data2)))
return 0;
switch (subtag)
{
case SUBTAG_POS_BIGNUM:
case SUBTAG_NEG_BIGNUM:
{
bignum_t *bn1 = (bignum_t *)term_data1;
bignum_t *bn2 = (bignum_t *)term_data2;
return bignum_compare(bn1, bn2) == 0;
}
case SUBTAG_FUN:
{
t_fun_t *f1 = (t_fun_t *)term_data1;
t_fun_t *f2 = (t_fun_t *)term_data2;
if (f1->module != f2->module ||
f1->index != f2->index ||
f1->old_uniq != f2->old_uniq)
return 0;
int num_free = fun_num_free(term_data1);
assert(num_free == fun_num_free(term_data2));
for (int i = 0; i < num_free; i++)
{
term_t v1 = f1->frozen[i];
term_t v2 = f2->frozen[i];
if (v1 != v2 && !are_terms_equal(v1, v2, exact))
return 0;
}
return 1;
}
case SUBTAG_EXPORT:
{
export_t *e1 = ((t_export_t *)term_data1)->e;
export_t *e2 = ((t_export_t *)term_data2)->e;
return e1->module == e2->module &&
e1->function == e2->function &&
e1->arity == e2->arity;
}
case SUBTAG_PID:
{
t_long_pid_t *pid1 = (t_long_pid_t *)term_data1;
t_long_pid_t *pid2 = (t_long_pid_t *)term_data2;
return pid1->node == pid2->node &&
pid1->serial == pid2->serial &&
opr_hdr_id(pid1) == opr_hdr_id(pid2) &&
opr_hdr_creat(pid1) == opr_hdr_creat(pid2);
}
case SUBTAG_OID:
{
t_long_oid_t *oid1 = (t_long_oid_t *)term_data1;
t_long_oid_t *oid2 = (t_long_oid_t *)term_data2;
return oid1->node == oid2->node &&
opr_hdr_id(oid1) == opr_hdr_id(oid2) &&
opr_hdr_creat(oid1) == opr_hdr_creat(oid2);
}
case SUBTAG_REF:
{
t_long_ref_t *ref1 = (t_long_ref_t *)term_data1;
t_long_ref_t *ref2 = (t_long_ref_t *)term_data2;
return ref1->node == ref2->node &&
ref1->id1 == ref2->id1 &&
ref1->id2 == ref2->id2 &&
opr_hdr_id(ref1) == opr_hdr_id(ref2) &&
opr_hdr_creat(ref1) == opr_hdr_creat(ref2);
}
case SUBTAG_PROC_BIN:
case SUBTAG_HEAP_BIN:
case SUBTAG_MATCH_CTX:
case SUBTAG_SUB_BIN:
{
bits_t bs1, bs2;
bits_get_real(term_data1, &bs1);
bits_get_real(term_data2, &bs2);
return (bits_compare(&bs1, &bs2) == 0);
}
default:
assert(subtag == SUBTAG_FLOAT);
return float_value(term_data1) == float_value(term_data2);
}
return 1;
}
}
int is_term_smaller(term_t a, term_t b)
{
if (a == b)
return 0;
if (are_both_immed(a, b))
{
if (are_both_int(a, b))
return int_value(a) < int_value(b);
if (is_int(a)) // !is_int(b)
return 1;
if (is_nil(a)) // !is_nil(b)
return 0;
if (is_nil(b)) // !is_nil(a)
return 1;
if (is_atom(a))
{
if (is_int(b))
return 0;
else if (is_atom(b))
{
uint8_t *print1 = atoms_get(atom_index(a));
uint8_t *print2 = atoms_get(atom_index(b));
int short_len = (print1[0] < print2[0])
? print1[0]
: print2[0];
int d = memcmp(print1+1, print2+1, short_len);
if (d == 0)
return print1[0] < print2[0];
return d < 0;
}
else
return 1;
}
else if (is_short_oid(a))
{
if (is_int(b) || is_atom(b))
return 0;
else if (is_short_oid(b))
return short_oid_id(a) < short_oid_id(b);
else
return 1;
}
else if (is_short_pid(a))
{
if (is_int(b) || is_atom(b) || is_short_oid(b))
return 0;
else
{
assert(is_short_pid(b));
return short_pid_id(a) < short_pid_id(b);
}
}
}
//TODO: comparison of bignum and float: docs mention the
// number 9007199254740992.0 and a loss of transitivity
if (!is_immed(a) && !is_immed(b) &&
primary_tag(a) == primary_tag(b))
{
if (is_cons(a))
return is_term_smaller_1(a, b);
else if (is_tuple(a))
return is_term_smaller_2(a, b);
else
{
assert(is_boxed(a) && is_boxed(b));
uint32_t *adata = peel_boxed(a);
uint32_t *bdata = peel_boxed(b);
if (boxed_tag(adata) == boxed_tag(bdata) ||
(is_binary(adata) && is_binary(bdata)) ||
(is_bignum(adata) && is_bignum(bdata)))
{
switch(boxed_tag(adata))
{
case SUBTAG_POS_BIGNUM:
case SUBTAG_NEG_BIGNUM:
return bignum_compare((bignum_t *)adata,
(bignum_t *)bdata) < 0;
case SUBTAG_FUN:
return fun_compare((t_fun_t *)adata,
(t_fun_t *)bdata) < 0;
case SUBTAG_EXPORT:
return export_compare((t_export_t *)adata,
(t_export_t *)bdata) < 0;
case SUBTAG_PID:
return pid_compare((t_long_pid_t *)adata,
(t_long_pid_t *)bdata) < 0;
case SUBTAG_OID:
return oid_compare((t_long_oid_t *)adata,
(t_long_oid_t *)bdata) < 0;
case SUBTAG_REF:
return ref_compare((t_long_ref_t *)adata,
(t_long_ref_t *)bdata) < 0;
case SUBTAG_PROC_BIN:
case SUBTAG_HEAP_BIN:
case SUBTAG_MATCH_CTX:
case SUBTAG_SUB_BIN:
return is_term_smaller_3(adata, bdata);
default:
assert(boxed_tag(adata) == SUBTAG_FLOAT);
return float_value(adata) < float_value(bdata);
}
}
}
}
// Number comparison with (mandatory) coercion
//
int use_float = (is_boxed(a) && boxed_tag(peel_boxed(a)) == SUBTAG_FLOAT) ||
(is_boxed(b) && boxed_tag(peel_boxed(b)) == SUBTAG_FLOAT);
if (use_float)
{
if (is_int(a)) // b is always float
return (double)int_value(a) < float_value(peel_boxed(b));
else if (is_boxed(a))
{
uint32_t *adata = peel_boxed(a);
if (is_bignum(adata)) // b is always float
return bignum_to_double((bignum_t *)adata) < float_value(peel_boxed(b));
if (boxed_tag(adata) == SUBTAG_FLOAT)
{
if (is_int(b))
return float_value(adata) < (double)int_value(b);
if (is_boxed(b))
{
uint32_t *bdata = peel_boxed(b);
if (is_bignum(bdata))
return float_value(adata) < bignum_to_double((bignum_t *)bdata);
}
}
}
}
else // use integer
{
if (is_int(a))
{
if (is_boxed(b))
{
uint32_t *bdata = peel_boxed(b);
if (is_bignum(bdata))
{
bignum_t *bbn = (bignum_t *)bdata;
return !bignum_is_neg(bbn);
}
assert(boxed_tag(bdata) != SUBTAG_FLOAT);
}
}
else if (is_boxed(a))
{
uint32_t *adata = peel_boxed(a);
if (is_bignum(adata))
{
bignum_t *abn = (bignum_t *)adata;
if (is_int(b))
return bignum_is_neg(abn);
if (is_boxed(b))
{
uint32_t *bdata = peel_boxed(b);
if (is_bignum(bdata))
return bignum_compare(abn, (bignum_t *)bdata);
assert(boxed_tag(bdata) != SUBTAG_FLOAT);
}
}
assert(boxed_tag(adata) != SUBTAG_FLOAT);
}
}
// a and b are quaranteed to have different types
//
return term_order(a) < term_order(b);
}
