//
// Dec64: C
//
REBDEC Dec64(const REBVAL *val)
{
if (IS_DECIMAL(val) || IS_PERCENT(val))
return VAL_DECIMAL(val);
if (IS_INTEGER(val))
return cast(REBDEC, VAL_INT64(val));
if (IS_MONEY(val))
return deci_to_decimal(VAL_MONEY_AMOUNT(val));
fail (Error_Invalid_Arg(val));
}
//
// Bin_To_Money_May_Fail: C
//
// Will successfully convert or fail (longjmp) with an error.
//
void Bin_To_Money_May_Fail(REBVAL *result, REBVAL *val)
{
REBCNT len;
REBYTE buf[MAX_HEX_LEN+4] = {0}; // binary to convert
if (IS_BINARY(val)) {
len = VAL_LEN_AT(val);
if (len > 12) len = 12;
memcpy(buf, VAL_BIN_AT(val), len);
}
else
fail (Error_Invalid_Arg(val));
memcpy(buf + 12 - len, buf, len); // shift to right side
memset(buf, 0, 12 - len);
VAL_MONEY_AMOUNT(result) = binary_to_deci(buf);
}
//
// CT_Money: C
//
REBINT CT_Money(const REBVAL *a, const REBVAL *b, REBINT mode)
{
REBOOL e, g;
if (mode >= 3) e = deci_is_same(VAL_MONEY_AMOUNT(a), VAL_MONEY_AMOUNT(b));
else {
e = deci_is_equal(VAL_MONEY_AMOUNT(a), VAL_MONEY_AMOUNT(b));
if (mode < 0) {
g = deci_is_lesser_or_equal(
VAL_MONEY_AMOUNT(b), VAL_MONEY_AMOUNT(a)
);
if (mode == -1) e = LOGICAL(e || g);
else e = LOGICAL(g && !e);
}
}
return e ? 1 : 0;
}
//
// CT_Money: C
//
REBINT CT_Money(REBVAL *a, REBVAL *b, REBINT mode)
{
REBFLG e, g;
if (mode >= 3) e = deci_is_same(VAL_MONEY_AMOUNT(a), VAL_MONEY_AMOUNT(b));
else {
e = deci_is_equal(VAL_MONEY_AMOUNT(a), VAL_MONEY_AMOUNT(b));
if (mode < 0) {
g = deci_is_lesser_or_equal(
VAL_MONEY_AMOUNT(b), VAL_MONEY_AMOUNT(a)
);
if (mode == -1) e |= g;
else e = g & !e;
}
}
return e != 0;;
}
*/ REBINT Bin_To_Money(REBVAL *result, REBVAL *val)
/*
***********************************************************************/
{
REBCNT len;
REBYTE buf[MAX_HEX_LEN+4] = {0}; // binary to convert
if (IS_BINARY(val)) {
len = VAL_LEN(val);
if (len > 12) len = 12;
memcpy(buf, VAL_BIN_DATA(val), len);
}
#ifdef removed
else if (IS_ISSUE(val)) {
//if (!(len = Scan_Hex_Bytes(val, 24, buf))) return FALSE;
REBYTE *ap = Get_Word_Name(val);
REBYTE *bp = &buf[0];
REBCNT alen;
REBUNI c;
len = LEN_BYTES(ap); // UTF-8 len
if (len & 1) return FALSE; // must have even # of chars
len /= 2;
if (len > 12) return FALSE; // valid even for UTF-8
for (alen = 0; alen < len; alen++) {
if (!Scan_Hex2(ap, &c, 0)) return FALSE;
*bp++ = (REBYTE)c;
ap += 2;
}
}
#endif
else
raise Error_Invalid_Arg(val);
memcpy(buf + 12 - len, buf, len); // shift to right side
memset(buf, 0, 12 - len);
VAL_MONEY_AMOUNT(result) = binary_to_deci(buf);
return TRUE;
}
//
// Emit_Money: C
//
REBINT Emit_Money(const REBVAL *value, REBYTE *buf, REBFLGS opts)
{
return deci_to_string(buf, VAL_MONEY_AMOUNT(value), '$', '.');
}
//
// MAKE_Decimal: C
//
void MAKE_Decimal(REBVAL *out, enum Reb_Kind kind, const REBVAL *arg) {
REBDEC d;
switch (VAL_TYPE(arg)) {
case REB_DECIMAL:
d = VAL_DECIMAL(arg);
goto dont_divide_if_percent;
case REB_PERCENT:
d = VAL_DECIMAL(arg);
goto dont_divide_if_percent;
case REB_INTEGER:
d = cast(REBDEC, VAL_INT64(arg));
goto dont_divide_if_percent;
case REB_MONEY:
d = deci_to_decimal(VAL_MONEY_AMOUNT(arg));
goto dont_divide_if_percent;
case REB_LOGIC:
d = VAL_LOGIC(arg) ? 1.0 : 0.0;
goto dont_divide_if_percent;
case REB_CHAR:
d = cast(REBDEC, VAL_CHAR(arg));
goto dont_divide_if_percent;
case REB_TIME:
d = VAL_TIME(arg) * NANO;
break;
case REB_STRING:
{
REBYTE *bp;
REBCNT len;
bp = Temp_Byte_Chars_May_Fail(arg, MAX_SCAN_DECIMAL, &len, FALSE);
VAL_RESET_HEADER(out, kind);
if (!Scan_Decimal(
&d, bp, len, LOGICAL(kind != REB_PERCENT)
)) {
goto bad_make;
}
break;
}
case REB_BINARY:
Binary_To_Decimal(arg, out);
VAL_RESET_HEADER(out, kind);
d = VAL_DECIMAL(out);
break;
#ifdef removed
// case REB_ISSUE:
{
REBYTE *bp;
REBCNT len;
bp = Temp_Byte_Chars_May_Fail(arg, MAX_HEX_LEN, &len, FALSE);
if (Scan_Hex(&VAL_INT64(out), bp, len, len) == 0)
fail (Error_Bad_Make(REB_DECIMAL, val));
d = VAL_DECIMAL(out);
break;
}
#endif
default:
if (ANY_ARRAY(arg) && VAL_ARRAY_LEN_AT(arg) == 2) {
RELVAL *item = VAL_ARRAY_AT(arg);
if (IS_INTEGER(item))
d = cast(REBDEC, VAL_INT64(item));
else if (IS_DECIMAL(item) || IS_PERCENT(item))
d = VAL_DECIMAL(item);
else {
REBVAL specific;
COPY_VALUE(&specific, item, VAL_SPECIFIER(arg));
fail (Error_Invalid_Arg(&specific));
}
++item;
REBDEC exp;
if (IS_INTEGER(item))
exp = cast(REBDEC, VAL_INT64(item));
else if (IS_DECIMAL(item) || IS_PERCENT(item))
exp = VAL_DECIMAL(item);
else {
REBVAL specific;
COPY_VALUE(&specific, item, VAL_SPECIFIER(arg));
fail (Error_Invalid_Arg(&specific));
}
while (exp >= 1) {
//
// !!! Comment here said "funky. There must be a better way"
//
--exp;
d *= 10.0;
if (!FINITE(d))
fail (Error(RE_OVERFLOW));
}
while (exp <= -1) {
++exp;
d /= 10.0;
}
}
else
fail (Error_Bad_Make(kind, arg));
}
if (kind == REB_PERCENT)
d /= 100.0;
dont_divide_if_percent:
if (!FINITE(d))
fail (Error(RE_OVERFLOW));
VAL_RESET_HEADER(out, kind);
VAL_DECIMAL(out) = d;
return;
bad_make:
fail (Error_Bad_Make(kind, arg));
}
//
// Cmp_Value: C
//
// Compare two values and return the difference.
//
// is_case TRUE for case sensitive compare
//
REBINT Cmp_Value(const RELVAL *s, const RELVAL *t, REBOOL is_case)
{
REBDEC d1, d2;
if (VAL_TYPE(t) != VAL_TYPE(s) && !(ANY_NUMBER(s) && ANY_NUMBER(t)))
return VAL_TYPE(s) - VAL_TYPE(t);
assert(NOT_END(s) && NOT_END(t));
switch(VAL_TYPE(s)) {
case REB_INTEGER:
if (IS_DECIMAL(t)) {
d1 = (REBDEC)VAL_INT64(s);
d2 = VAL_DECIMAL(t);
goto chkDecimal;
}
return THE_SIGN(VAL_INT64(s) - VAL_INT64(t));
case REB_LOGIC:
return VAL_LOGIC(s) - VAL_LOGIC(t);
case REB_CHAR:
if (is_case) return THE_SIGN(VAL_CHAR(s) - VAL_CHAR(t));
return THE_SIGN((REBINT)(UP_CASE(VAL_CHAR(s)) - UP_CASE(VAL_CHAR(t))));
case REB_PERCENT:
case REB_DECIMAL:
case REB_MONEY:
if (IS_MONEY(s))
d1 = deci_to_decimal(VAL_MONEY_AMOUNT(s));
else
d1 = VAL_DECIMAL(s);
if (IS_INTEGER(t))
d2 = cast(REBDEC, VAL_INT64(t));
else if (IS_MONEY(t))
d2 = deci_to_decimal(VAL_MONEY_AMOUNT(t));
else
d2 = VAL_DECIMAL(t);
chkDecimal:
if (Eq_Decimal(d1, d2))
return 0;
if (d1 < d2)
return -1;
return 1;
case REB_PAIR:
return Cmp_Pair(s, t);
case REB_EVENT:
return Cmp_Event(s, t);
case REB_GOB:
return Cmp_Gob(s, t);
case REB_TUPLE:
return Cmp_Tuple(s, t);
case REB_TIME:
return Cmp_Time(s, t);
case REB_DATE:
return Cmp_Date(s, t);
case REB_BLOCK:
case REB_GROUP:
case REB_MAP:
case REB_PATH:
case REB_SET_PATH:
case REB_GET_PATH:
case REB_LIT_PATH:
return Cmp_Array(s, t, is_case);
case REB_STRING:
case REB_FILE:
case REB_EMAIL:
case REB_URL:
case REB_TAG:
return Compare_String_Vals(s, t, NOT(is_case));
case REB_BITSET:
case REB_BINARY:
case REB_IMAGE:
return Compare_Binary_Vals(s, t);
case REB_VECTOR:
return Compare_Vector(s, t);
case REB_DATATYPE:
return VAL_TYPE_KIND(s) - VAL_TYPE_KIND(t);
case REB_WORD:
case REB_SET_WORD:
case REB_GET_WORD:
case REB_LIT_WORD:
case REB_REFINEMENT:
case REB_ISSUE:
return Compare_Word(s,t,is_case);
case REB_ERROR:
return VAL_ERR_NUM(s) - VAL_ERR_NUM(t);
case REB_OBJECT:
case REB_MODULE:
case REB_PORT:
return VAL_CONTEXT(s) - VAL_CONTEXT(t);
case REB_FUNCTION:
return VAL_FUNC_PARAMLIST(s) - VAL_FUNC_PARAMLIST(t);
case REB_LIBRARY:
return VAL_LIBRARY(s) - VAL_LIBRARY(t);
case REB_STRUCT:
return Cmp_Struct(s, t);
case REB_BLANK:
case REB_MAX_VOID:
default:
break;
}
return 0;
}
static REBSER *make_binary(const REBVAL *arg, REBOOL make)
{
REBSER *ser;
// MAKE BINARY! 123
switch (VAL_TYPE(arg)) {
case REB_INTEGER:
case REB_DECIMAL:
if (make) ser = Make_Binary(Int32s(arg, 0));
else ser = Make_Binary_BE64(arg);
break;
// MAKE/TO BINARY! BINARY!
case REB_BINARY:
ser = Copy_Bytes(VAL_BIN_AT(arg), VAL_LEN_AT(arg));
break;
// MAKE/TO BINARY! <any-string>
case REB_STRING:
case REB_FILE:
case REB_EMAIL:
case REB_URL:
case REB_TAG:
// case REB_ISSUE:
ser = Make_UTF8_From_Any_String(arg, VAL_LEN_AT(arg), 0);
break;
case REB_BLOCK:
// Join_Binary returns a shared buffer, so produce a copy:
ser = Copy_Sequence(Join_Binary(arg, -1));
break;
// MAKE/TO BINARY! <tuple!>
case REB_TUPLE:
ser = Copy_Bytes(VAL_TUPLE(arg), VAL_TUPLE_LEN(arg));
break;
// MAKE/TO BINARY! <char!>
case REB_CHAR:
ser = Make_Binary(6);
TERM_SEQUENCE_LEN(ser, Encode_UTF8_Char(BIN_HEAD(ser), VAL_CHAR(arg)));
break;
// MAKE/TO BINARY! <bitset!>
case REB_BITSET:
ser = Copy_Bytes(VAL_BIN(arg), VAL_LEN_HEAD(arg));
break;
// MAKE/TO BINARY! <image!>
case REB_IMAGE:
ser = Make_Image_Binary(arg);
break;
case REB_MONEY:
ser = Make_Binary(12);
deci_to_binary(BIN_HEAD(ser), VAL_MONEY_AMOUNT(arg));
TERM_SEQUENCE_LEN(ser, 12);
break;
default:
ser = 0;
}
return ser;
}