*/ 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;
}
//
// MAKE_Tuple: C
//
REB_R MAKE_Tuple(
REBVAL *out,
enum Reb_Kind kind,
const REBVAL *opt_parent,
const REBVAL *arg
){
assert(kind == REB_TUPLE);
if (opt_parent)
fail (Error_Bad_Make_Parent(kind, opt_parent));
if (IS_TUPLE(arg))
return Move_Value(out, arg);
RESET_CELL(out, REB_TUPLE, CELL_MASK_NONE);
REBYTE *vp = VAL_TUPLE(out);
// !!! Net lookup parses IP addresses out of `tcp://93.184.216.34` or
// similar URL!s. In Rebol3 these captures come back the same type
// as the input instead of as STRING!, which was a latent bug in the
// network code of the 12-Dec-2012 release:
//
// https://github.com/rebol/rebol/blob/master/src/mezz/sys-ports.r#L110
//
// All attempts to convert a URL!-flavored IP address failed. Taking
// URL! here fixes it, though there are still open questions.
//
if (IS_TEXT(arg) or IS_URL(arg)) {
REBSIZ size;
const REBYTE *bp
= Analyze_String_For_Scan(&size, arg, MAX_SCAN_TUPLE);
if (Scan_Tuple(out, bp, size) == nullptr)
fail (arg);
return out;
}
if (ANY_ARRAY(arg)) {
REBCNT len = 0;
REBINT n;
RELVAL *item = VAL_ARRAY_AT(arg);
for (; NOT_END(item); ++item, ++vp, ++len) {
if (len >= MAX_TUPLE)
goto bad_make;
if (IS_INTEGER(item)) {
n = Int32(item);
}
else if (IS_CHAR(item)) {
n = VAL_CHAR(item);
}
else
goto bad_make;
if (n > 255 || n < 0)
goto bad_make;
*vp = n;
}
VAL_TUPLE_LEN(out) = len;
for (; len < MAX_TUPLE; len++) *vp++ = 0;
return out;
}
REBCNT alen;
if (IS_ISSUE(arg)) {
REBSTR *spelling = VAL_STRING(arg);
const REBYTE *ap = STR_HEAD(spelling);
size_t size = STR_SIZE(spelling); // UTF-8 len
if (size & 1)
fail (arg); // must have even # of chars
size /= 2;
if (size > MAX_TUPLE)
fail (arg); // valid even for UTF-8
VAL_TUPLE_LEN(out) = size;
for (alen = 0; alen < size; alen++) {
REBYTE decoded;
if ((ap = Scan_Hex2(&decoded, ap)) == NULL)
fail (arg);
*vp++ = decoded;
}
}
else if (IS_BINARY(arg)) {
REBYTE *ap = VAL_BIN_AT(arg);
REBCNT len = VAL_LEN_AT(arg);
if (len > MAX_TUPLE) len = MAX_TUPLE;
VAL_TUPLE_LEN(out) = len;
for (alen = 0; alen < len; alen++) *vp++ = *ap++;
}
else
fail (arg);
for (; alen < MAX_TUPLE; alen++) *vp++ = 0;
return out;
bad_make:
fail (Error_Bad_Make(REB_TUPLE, arg));
}
//
// MAKE_Tuple: C
//
void MAKE_Tuple(REBVAL *out, enum Reb_Kind type, const REBVAL *arg)
{
if (IS_TUPLE(arg)) {
*out = *arg;
return;
}
VAL_RESET_HEADER(out, REB_TUPLE);
REBYTE *vp = VAL_TUPLE(out);
// !!! Net lookup parses IP addresses out of `tcp://93.184.216.34` or
// similar URL!s. In Rebol3 these captures come back the same type
// as the input instead of as STRING!, which was a latent bug in the
// network code of the 12-Dec-2012 release:
//
// https://github.com/rebol/rebol/blob/master/src/mezz/sys-ports.r#L110
//
// All attempts to convert a URL!-flavored IP address failed. Taking
// URL! here fixes it, though there are still open questions.
//
if (IS_STRING(arg) || IS_URL(arg)) {
REBCNT len;
REBYTE *ap = Temp_Byte_Chars_May_Fail(arg, MAX_SCAN_TUPLE, &len, FALSE);
if (Scan_Tuple(ap, len, out))
return;
goto bad_arg;
}
if (ANY_ARRAY(arg)) {
REBCNT len = 0;
REBINT n;
RELVAL *item = VAL_ARRAY_AT(arg);
for (; NOT_END(item); ++item, ++vp, ++len) {
if (len >= MAX_TUPLE) goto bad_make;
if (IS_INTEGER(item)) {
n = Int32(item);
}
else if (IS_CHAR(item)) {
n = VAL_CHAR(item);
}
else
goto bad_make;
if (n > 255 || n < 0) goto bad_make;
*vp = n;
}
VAL_TUPLE_LEN(out) = len;
for (; len < MAX_TUPLE; len++) *vp++ = 0;
return;
}
REBCNT alen;
if (IS_ISSUE(arg)) {
REBUNI c;
const REBYTE *ap = VAL_WORD_HEAD(arg);
REBCNT len = LEN_BYTES(ap); // UTF-8 len
if (len & 1) goto bad_arg; // must have even # of chars
len /= 2;
if (len > MAX_TUPLE) goto bad_arg; // valid even for UTF-8
VAL_TUPLE_LEN(out) = len;
for (alen = 0; alen < len; alen++) {
const REBOOL unicode = FALSE;
if (!Scan_Hex2(ap, &c, unicode)) goto bad_arg;
*vp++ = cast(REBYTE, c);
ap += 2;
}
}
else if (IS_BINARY(arg)) {
REBYTE *ap = VAL_BIN_AT(arg);
REBCNT len = VAL_LEN_AT(arg);
if (len > MAX_TUPLE) len = MAX_TUPLE;
VAL_TUPLE_LEN(out) = len;
for (alen = 0; alen < len; alen++) *vp++ = *ap++;
}
else goto bad_arg;
for (; alen < MAX_TUPLE; alen++) *vp++ = 0;
return;
bad_arg:
fail (Error_Invalid_Arg(arg));
bad_make:
fail (Error_Bad_Make(REB_TUPLE, arg));
}
*/ REBYTE *Scan_Item(REBYTE *src, REBYTE *end, REBUNI term, REBYTE *invalid)
/*
** Scan as UTF8 an item like a file or URL.
**
** Returns continuation point or zero for error.
**
** Put result into the MOLD_BUF as uni-chars.
**
***********************************************************************/
{
REBUNI c;
REBSER *buf;
buf = BUF_MOLD;
RESET_TAIL(buf);
while (src < end && *src != term) {
c = *src;
// End of stream?
if (c == 0) break;
// If no term, then any white will terminate:
if (!term && IS_WHITE(c)) break;
// Ctrl chars are invalid:
if (c < ' ') return 0; // invalid char
if (c == '\\') c = '/';
// Accept %xx encoded char:
else if (c == '%') {
if (!Scan_Hex2(src+1, &c, FALSE)) return 0;
src += 2;
}
// Accept ^X encoded char:
else if (c == '^') {
if (src+1 == end) return 0; // nothing follows ^
c = Scan_Char(&src);
if (!term && IS_WHITE(c)) break;
src--;
}
// Accept UTF8 encoded char:
else if (c >= 0x80) {
c = Decode_UTF8_Char(&src, 0); // zero on error
if (c == 0) return 0;
}
// Is char as literal valid? (e.g. () [] etc.)
else if (invalid && strchr(invalid, c)) return 0;
src++;
*UNI_SKIP(buf, buf->tail) = c; // not affected by Extend_Series
if (++(buf->tail) >= SERIES_REST(buf)) Extend_Series(buf, 1);
}
if (*src && *src == term) src++;
UNI_TERM(buf);
return src;
}
