// // 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; }