*/ REBINT Emit_Tuple(REBVAL *value, REBYTE *out)
/*
** The out array must be large enough to hold longest tuple.
** Longest is: (3 digits + '.') * 11 nums + 1 term => 45
**
***********************************************************************/
{
REBCNT len;
REBYTE *tp;
REBYTE *start = out;
len = VAL_TUPLE_LEN(value);
tp = (REBYTE *)VAL_TUPLE(value);
for (; len > 0; len--, tp++) {
out = Form_Int(out, *tp);
*out++ = '.';
}
len = VAL_TUPLE_LEN(value);
while (len++ < 3) {
*out++ = '0';
*out++ = '.';
}
*--out = 0;
return out-start;
}
//
// MF_Tuple: C
//
void MF_Tuple(REB_MOLD *mo, const REBCEL *v, bool form)
{
UNUSED(form);
// "Buffer must be large enough to hold longest tuple.
// Longest is: (3 digits + '.') * 11 nums + 1 term => 45"
//
// !!! ^-- Out of date comments; TUPLE! needs review and replacement.
//
REBYTE buf[60];
REBCNT len = VAL_TUPLE_LEN(v);
const REBYTE *tp = cast(const REBYTE *, VAL_TUPLE(v));
REBYTE *out = buf;
for (; len > 0; len--, tp++) {
out = Form_Int(out, *tp);
*out++ = '.';
}
len = VAL_TUPLE_LEN(v);
while (len++ < 3) {
*out++ = '0';
*out++ = '.';
}
*--out = 0;
Append_Ascii_Len(mo->series, s_cast(buf), out - buf);
}
//
// CT_Tuple: C
//
REBINT CT_Tuple(const REBCEL *a, const REBCEL *b, REBINT mode)
{
REBINT num = Cmp_Tuple(a, b);
if (mode > 1) return (num == 0 && VAL_TUPLE_LEN(a) == VAL_TUPLE_LEN(b));
if (mode >= 0) return (num == 0);
if (mode == -1) return (num >= 0);
return (num > 0);
}
*/ REBINT CT_Tuple(REBVAL *a, REBVAL *b, REBINT mode)
/*
***********************************************************************/
{
REBINT num = Cmp_Tuple(a, b);
if (mode > 1) return (num == 0 && VAL_TUPLE_LEN(a) == VAL_TUPLE_LEN(b));
if (mode >= 0) return (num == 0);
if (mode == -1) return (num >= 0);
return (num > 0);
}
//
// PD_Tuple: C
//
// Implements PATH and SET_PATH for tuple.
// Sets DS_TOP if found. Always returns 0.
//
REBINT PD_Tuple(REBPVS *pvs)
{
const REBVAL *setval;
REBINT n;
REBINT i;
REBYTE *dat;
REBINT len;
dat = VAL_TUPLE(pvs->value);
len = VAL_TUPLE_LEN(pvs->value);
if (len < 3) {
len = 3;
}
n = Get_Num_From_Arg(pvs->selector);
if ((setval = pvs->opt_setval)) {
if (n <= 0 || n > cast(REBINT, MAX_TUPLE))
fail (Error_Bad_Path_Select(pvs));
if (IS_INTEGER(setval) || IS_DECIMAL(setval))
i = Int32(setval);
else if (IS_BLANK(setval)) {
n--;
CLEAR(dat + n, MAX_TUPLE - n);
VAL_TUPLE_LEN(pvs->value) = n;
return PE_OK;
}
else
fail (Error_Bad_Path_Set(pvs));
if (i < 0) i = 0;
else if (i > 255) i = 255;
dat[n - 1] = i;
if (n > len)
VAL_TUPLE_LEN(pvs->value) = n;
return PE_OK;
}
else {
if (n > 0 && n <= len) {
SET_INTEGER(pvs->store, dat[n - 1]);
return PE_USE_STORE;
}
else return PE_NONE;
}
}
*/ REBFLG MT_Tuple(REBVAL *out, REBVAL *data, REBCNT type)
/*
***********************************************************************/
{
REBYTE *vp;
REBINT len = 0;
REBINT n;
vp = VAL_TUPLE(out);
for (; NOT_END(data); data++, vp++, len++) {
if (len >= 10) return FALSE;
if (IS_INTEGER(data)) {
n = Int32(data);
}
else if (IS_CHAR(data)) {
n = VAL_CHAR(data);
}
else return FALSE;
if (n > 255 || n < 0) return FALSE;
*vp = n;
}
VAL_TUPLE_LEN(out) = len;
for (; len < 10; len++) *vp++ = 0;
VAL_SET(out, type);
return TRUE;
}
//
// Cmp_Tuple: C
//
// Given two tuples, compare them.
//
REBINT Cmp_Tuple(const RELVAL *t1, const RELVAL *t2)
{
REBCNT len;
const REBYTE *vp1, *vp2;
REBINT n;
len = MAX(VAL_TUPLE_LEN(t1), VAL_TUPLE_LEN(t2));
vp1 = VAL_TUPLE(t1);
vp2 = VAL_TUPLE(t2);
for (; len > 0; len--, vp1++,vp2++) {
n = (REBINT)(*vp1 - *vp2);
if (n != 0)
return n;
}
return 0;
}
//
// Set_Tuple: C
//
void Set_Tuple(REBVAL *value, REBYTE *bytes, REBCNT len)
{
REBYTE *bp;
VAL_RESET_HEADER(value, REB_TUPLE);
VAL_TUPLE_LEN(value) = (REBYTE)len;
for (bp = VAL_TUPLE(value); len > 0; len--)
*bp++ = *bytes++;
}
//
// Cmp_Tuple: C
//
// Given two tuples, compare them.
//
REBINT Cmp_Tuple(const REBCEL *t1, const REBCEL *t2)
{
REBCNT len = MAX(VAL_TUPLE_LEN(t1), VAL_TUPLE_LEN(t2));
assert(len < MAX_TUPLE);
const REBYTE *vp1 = VAL_TUPLE(t1);
const REBYTE *vp2 = VAL_TUPLE(t2);
// Note: unused bytes in tuples are 0, so that 1.0.0 can = 1.0.0.0
REBINT n;
for (; len > 0; len--, ++vp1, ++vp2) {
n = cast(REBINT, *vp1) - *vp2;
if (n != 0)
return n;
}
return 0;
}
*/ void Set_Tuple(REBVAL *value, REBYTE *bytes, REBCNT len)
/*
***********************************************************************/
{
REBYTE *bp;
VAL_SET(value, REB_TUPLE);
VAL_TUPLE_LEN(value) = (REBYTE)len;
for (bp = VAL_TUPLE(value); len > 0; len--)
*bp++ = *bytes++;
}
//
// Emit_Tuple: C
//
// The out array must be large enough to hold longest tuple.
// Longest is: (3 digits + '.') * 11 nums + 1 term => 45
//
REBINT Emit_Tuple(const REBVAL *value, REBYTE *out)
{
REBCNT len = VAL_TUPLE_LEN(value);
const REBYTE *tp = cast(const REBYTE *, VAL_TUPLE(value));
REBYTE *start = out;
for (; len > 0; len--, tp++) {
out = Form_Int(out, *tp);
*out++ = '.';
}
len = VAL_TUPLE_LEN(value);
while (len++ < 3) {
*out++ = '0';
*out++ = '.';
}
*--out = 0;
return out-start;
}
*/ REBINT PD_Tuple(REBPVS *pvs)
/*
** Implements PATH and SET_PATH for tuple.
** Sets DS_TOP if found. Always returns 0.
**
***********************************************************************/
{
REBVAL *val;
REBINT n;
REBINT i;
REBYTE *dat;
REBINT len;
dat = VAL_TUPLE(pvs->value);
len = VAL_TUPLE_LEN(pvs->value);
if (len < 3) len = 3;
n = Get_Num_Arg(pvs->select);
if (NZ(val = pvs->setval)) {
if (n <= 0 || n > MAX_TUPLE) return PE_BAD_SELECT;
if (IS_INTEGER(val) || IS_DECIMAL(val)) i = Int32(val);
else if (IS_NONE(val)) {
n--;
CLEAR(dat+n, MAX_TUPLE-n);
VAL_TUPLE_LEN(pvs->value) = n;
return PE_OK;
}
else return PE_BAD_SET;
if (i < 0) i = 0;
else if (i > 255) i = 255;
dat[n-1] = i;
if (n > len) VAL_TUPLE_LEN(pvs->value) = n;
return PE_OK;
} else {
if (n > 0 && n <= len) {
SET_INTEGER(pvs->store, dat[n-1]);
return PE_USE;
}
else return PE_NONE;
}
}
*/ REBINT Cmp_Tuple(REBVAL *t1, REBVAL *t2)
/*
** Given two tuples, compare them.
**
***********************************************************************/
{
REBCNT len;
REBYTE *vp1, *vp2;
REBINT n;
len = MAX(VAL_TUPLE_LEN(t1), VAL_TUPLE_LEN(t2));
vp1 = VAL_TUPLE(t1);
vp2 = VAL_TUPLE(t2);
for (;len > 0; len--, vp1++,vp2++) {
n = (REBINT)(*vp1 - *vp2);
if (n != 0)
return n;
}
return 0;
}
//
// Poke_Tuple_Immediate: C
//
// !!! Note: In the current implementation, tuples are immediate values.
// So a POKE only changes the `value` in your hand.
//
void Poke_Tuple_Immediate(
REBVAL *value,
const REBVAL *picker,
const REBVAL *poke
) {
REBYTE *dat = VAL_TUPLE(value);
REBINT len = VAL_TUPLE_LEN(value);
if (len < 3)
len = 3;
REBINT n = Get_Num_From_Arg(picker);
if (n <= 0 || n > cast(REBINT, MAX_TUPLE))
fail (Error_Out_Of_Range(picker));
REBINT i;
if (IS_INTEGER(poke) || IS_DECIMAL(poke))
i = Int32(poke);
else if (IS_BLANK(poke)) {
n--;
CLEAR(dat + n, MAX_TUPLE - n);
VAL_TUPLE_LEN(value) = n;
return;
}
else
fail (poke);
if (i < 0)
i = 0;
else if (i > 255)
i = 255;
dat[n - 1] = i;
if (n > len)
VAL_TUPLE_LEN(value) = n;
}
//
// Pick_Tuple: C
//
void Pick_Tuple(REBVAL *out, const REBVAL *value, const REBVAL *picker)
{
const REBYTE *dat = VAL_TUPLE(value);
REBINT len = VAL_TUPLE_LEN(value);
if (len < 3)
len = 3;
REBINT n = Get_Num_From_Arg(picker);
// This uses modulus to avoid having a conditional access into the array,
// which would trigger Spectre mitigation:
//
// https://stackoverflow.com/questions/50399940/
//
// By always accessing the array and always being in bounds, there's no
// speculative execution accessing unbound locations.
//
REBYTE byte = dat[(n - 1) % len];
if (n > 0 and n <= len)
Init_Integer(out, byte);
else
Init_Nulled(out);
}
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;
}
//
// 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));
}
*/ static REBFLG Set_GOB_Var(REBGOB *gob, REBVAL *word, REBVAL *val)
/*
***********************************************************************/
{
REBVAL *spec;
REBVAL *hndl;
switch (VAL_WORD_CANON(word)) {
case SYM_OFFSET:
return Set_Pair(&(gob->offset), val);
case SYM_SIZE:
return Set_Pair(&gob->size, val);
case SYM_IMAGE:
CLR_GOB_OPAQUE(gob);
if (IS_IMAGE(val)) {
SET_GOB_TYPE(gob, GOBT_IMAGE);
GOB_W(gob) = (REBD32)VAL_IMAGE_WIDE(val);
GOB_H(gob) = (REBD32)VAL_IMAGE_HIGH(val);
GOB_CONTENT(gob) = VAL_SERIES(val);
// if (!VAL_IMAGE_TRANSP(val)) SET_GOB_OPAQUE(gob);
}
else if (IS_NONE(val)) SET_GOB_TYPE(gob, GOBT_NONE);
else return FALSE;
break;
#ifdef HAS_WIDGET_GOB
case SYM_WIDGET:
//printf("WIDGET GOB\n");
SET_GOB_TYPE(gob, GOBT_WIDGET);
SET_GOB_OPAQUE(gob);
GOB_CONTENT(gob) = Make_Block(4); // [handle type spec data]
hndl = Append_Value(GOB_CONTENT(gob));
Append_Value(GOB_CONTENT(gob)); // used to cache type on host's side
spec = Append_Value(GOB_CONTENT(gob));
Append_Value(GOB_CONTENT(gob)); // used to cache result data
SET_HANDLE(hndl, 0, SYM_WIDGET, 0);
if (IS_WORD(val) || IS_LIT_WORD(val)) {
Set_Block(spec, Make_Block(1));
Append_Val(VAL_SERIES(spec), val);
}
else if (IS_BLOCK(val)) {
Set_Block(spec, VAL_SERIES(val));
}
else return FALSE;
break;
#endif // HAS_WIDGET_GOB
case SYM_DRAW:
CLR_GOB_OPAQUE(gob);
if (IS_BLOCK(val)) {
SET_GOB_TYPE(gob, GOBT_DRAW);
GOB_CONTENT(gob) = VAL_SERIES(val);
}
else if (IS_NONE(val)) SET_GOB_TYPE(gob, GOBT_NONE);
else return FALSE;
break;
case SYM_TEXT:
CLR_GOB_OPAQUE(gob);
if (IS_BLOCK(val)) {
SET_GOB_TYPE(gob, GOBT_TEXT);
GOB_CONTENT(gob) = VAL_SERIES(val);
}
else if (IS_STRING(val)) {
SET_GOB_TYPE(gob, GOBT_STRING);
GOB_CONTENT(gob) = VAL_SERIES(val);
}
else if (IS_NONE(val)) SET_GOB_TYPE(gob, GOBT_NONE);
else return FALSE;
break;
case SYM_EFFECT:
CLR_GOB_OPAQUE(gob);
if (IS_BLOCK(val)) {
SET_GOB_TYPE(gob, GOBT_EFFECT);
GOB_CONTENT(gob) = VAL_SERIES(val);
}
else if (IS_NONE(val)) SET_GOB_TYPE(gob, GOBT_NONE);
else return FALSE;
break;
case SYM_COLOR:
CLR_GOB_OPAQUE(gob);
if (IS_TUPLE(val)) {
SET_GOB_TYPE(gob, GOBT_COLOR);
Set_Pixel_Tuple((REBYTE*)&GOB_CONTENT(gob), val);
if (VAL_TUPLE_LEN(val) < 4 || VAL_TUPLE(val)[3] == 255)
SET_GOB_OPAQUE(gob);
}
else if (IS_NONE(val)) SET_GOB_TYPE(gob, GOBT_NONE);
break;
case SYM_PANE:
if (GOB_PANE(gob)) Clear_Series(GOB_PANE(gob));
if (IS_BLOCK(val))
Insert_Gobs(gob, VAL_BLK_DATA(val), 0, VAL_BLK_LEN(val), 0);
else if (IS_GOB(val))
Insert_Gobs(gob, val, 0, 1, 0);
else if (IS_NONE(val))
gob->pane = 0;
else
return FALSE;
break;
case SYM_ALPHA:
GOB_ALPHA(gob) = Clip_Int(Int32(val), 0, 255);
break;
case SYM_DATA:
#ifdef HAS_WIDGET_GOB
if (GOB_TYPE(gob) == GOBT_WIDGET) {
OS_SET_WIDGET_DATA(gob, val);
} else {
#endif
SET_GOB_DTYPE(gob, GOBD_NONE);
if (IS_OBJECT(val)) {
SET_GOB_DTYPE(gob, GOBD_OBJECT);
SET_GOB_DATA(gob, VAL_OBJ_FRAME(val));
}
else if (IS_BLOCK(val)) {
SET_GOB_DTYPE(gob, GOBD_BLOCK);
SET_GOB_DATA(gob, VAL_SERIES(val));
}
else if (IS_STRING(val)) {
SET_GOB_DTYPE(gob, GOBD_STRING);
SET_GOB_DATA(gob, VAL_SERIES(val));
}
else if (IS_BINARY(val)) {
SET_GOB_DTYPE(gob, GOBD_BINARY);
SET_GOB_DATA(gob, VAL_SERIES(val));
}
else if (IS_INTEGER(val)) {
SET_GOB_DTYPE(gob, GOBD_INTEGER);
SET_GOB_DATA(gob, (void*)(REBIPT)VAL_INT64(val));
}
else if (IS_NONE(val))
SET_GOB_TYPE(gob, GOBT_NONE);
else return FALSE;
#ifdef HAS_WIDGET_GOB
}
#endif
break;
case SYM_FLAGS:
if (IS_WORD(val)) Set_Gob_Flag(gob, val);
else if (IS_BLOCK(val)) {
gob->flags = 0;
for (val = VAL_BLK(val); NOT_END(val); val++) {
if (IS_WORD(val)) Set_Gob_Flag(gob, val);
}
}
break;
case SYM_OWNER:
if (IS_GOB(val))
GOB_TMP_OWNER(gob) = VAL_GOB(val);
else
return FALSE;
break;
default:
return FALSE;
}
return TRUE;
}
*/ static REBFLG Set_GOB_Var(REBGOB *gob, REBVAL *word, REBVAL *val)
/*
***********************************************************************/
{
switch (VAL_WORD_CANON(word)) {
case SYM_OFFSET:
return Set_Pair(&(gob->offset), val);
case SYM_SIZE:
return Set_Pair(&gob->size, val);
case SYM_IMAGE:
CLR_GOB_OPAQUE(gob);
if (IS_IMAGE(val)) {
SET_GOB_TYPE(gob, GOBT_IMAGE);
GOB_W(gob) = (REBD32)VAL_IMAGE_WIDE(val);
GOB_H(gob) = (REBD32)VAL_IMAGE_HIGH(val);
GOB_CONTENT(gob) = VAL_SERIES(val);
// if (!VAL_IMAGE_TRANSP(val)) SET_GOB_OPAQUE(gob);
}
else if (IS_NONE(val)) SET_GOB_TYPE(gob, GOBT_NONE);
else return FALSE;
break;
case SYM_DRAW:
CLR_GOB_OPAQUE(gob);
if (IS_BLOCK(val)) {
SET_GOB_TYPE(gob, GOBT_DRAW);
GOB_CONTENT(gob) = VAL_SERIES(val);
}
else if (IS_NONE(val)) SET_GOB_TYPE(gob, GOBT_NONE);
else return FALSE;
break;
case SYM_TEXT:
CLR_GOB_OPAQUE(gob);
if (IS_BLOCK(val)) {
SET_GOB_TYPE(gob, GOBT_TEXT);
GOB_CONTENT(gob) = VAL_SERIES(val);
}
else if (IS_STRING(val)) {
SET_GOB_TYPE(gob, GOBT_STRING);
GOB_CONTENT(gob) = VAL_SERIES(val);
}
else if (IS_NONE(val)) SET_GOB_TYPE(gob, GOBT_NONE);
else return FALSE;
break;
case SYM_EFFECT:
CLR_GOB_OPAQUE(gob);
if (IS_BLOCK(val)) {
SET_GOB_TYPE(gob, GOBT_EFFECT);
GOB_CONTENT(gob) = VAL_SERIES(val);
}
else if (IS_NONE(val)) SET_GOB_TYPE(gob, GOBT_NONE);
else return FALSE;
break;
case SYM_COLOR:
CLR_GOB_OPAQUE(gob);
if (IS_TUPLE(val)) {
SET_GOB_TYPE(gob, GOBT_COLOR);
Set_Pixel_Tuple((REBYTE*)&GOB_CONTENT(gob), val);
if (VAL_TUPLE_LEN(val) < 4 || VAL_TUPLE(val)[3] == 0)
SET_GOB_OPAQUE(gob);
}
else if (IS_NONE(val)) SET_GOB_TYPE(gob, GOBT_NONE);
break;
case SYM_PANE:
if (GOB_PANE(gob)) Clear_Series(GOB_PANE(gob));
if (IS_BLOCK(val))
Insert_Gobs(gob, VAL_BLK_DATA(val), 0, VAL_BLK_LEN(val), 0);
else if (IS_GOB(val))
Insert_Gobs(gob, val, 0, 1, 0);
else if (IS_NONE(val))
gob->pane = 0;
else
return FALSE;
break;
case SYM_ALPHA:
GOB_ALPHA(gob) = Clip_Int(Int32(val), 0, 255);
break;
case SYM_DATA:
SET_GOB_DTYPE(gob, GOBD_NONE);
if (IS_OBJECT(val)) {
SET_GOB_DTYPE(gob, GOBD_OBJECT);
SET_GOB_DATA(gob, VAL_OBJ_FRAME(val));
}
else if (IS_BLOCK(val)) {
SET_GOB_DTYPE(gob, GOBD_BLOCK);
SET_GOB_DATA(gob, VAL_SERIES(val));
}
else if (IS_STRING(val)) {
SET_GOB_DTYPE(gob, GOBD_STRING);
SET_GOB_DATA(gob, VAL_SERIES(val));
}
else if (IS_BINARY(val)) {
SET_GOB_DTYPE(gob, GOBD_BINARY);
SET_GOB_DATA(gob, VAL_SERIES(val));
}
else if (IS_INTEGER(val)) {
SET_GOB_DTYPE(gob, GOBD_INTEGER);
SET_GOB_DATA(gob, (void*)(REBIPT)VAL_INT64(val));
}
else if (IS_NONE(val))
SET_GOB_TYPE(gob, GOBT_NONE);
else return FALSE;
break;
case SYM_FLAGS:
if (IS_WORD(val)) Set_Gob_Flag(gob, val);
else if (IS_BLOCK(val)) {
gob->flags = 0;
for (val = VAL_BLK(val); NOT_END(val); val++) {
if (IS_WORD(val)) Set_Gob_Flag(gob, val);
}
}
break;
case SYM_OWNER:
if (IS_GOB(val))
GOB_TMP_OWNER(gob) = VAL_GOB(val);
else
return FALSE;
break;
default:
return FALSE;
}
return TRUE;
}
static REBSER *make_binary(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_DATA(arg), VAL_LEN(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 = Encode_UTF8_Value(arg, VAL_LEN(arg), 0);
break;
case REB_BLOCK:
ser = Join_Binary(arg);
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);
ser->tail = Encode_UTF8_Char(BIN_HEAD(ser), VAL_CHAR(arg));
break;
// MAKE/TO BINARY! <bitset!>
case REB_BITSET:
ser = Copy_Bytes(VAL_BIN(arg), VAL_TAIL(arg));
break;
// MAKE/TO BINARY! <image!>
case REB_IMAGE:
ser = Make_Image_Binary(arg);
break;
case REB_MONEY:
ser = Make_Binary(12);
ser->tail = 12;
deci_to_binary(ser->data, VAL_DECI(arg));
ser->data[12] = 0;
break;
default:
ser = 0;
}
return ser;
}
//
// 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));
}
