*/ static void Loop_Number(REBVAL *out, REBVAL *var, REBSER* body, REBVAL *start, REBVAL *end, REBVAL *incr)
/*
***********************************************************************/
{
REBDEC s;
REBDEC e;
REBDEC i;
if (IS_INTEGER(start)) s = cast(REBDEC, VAL_INT64(start));
else if (IS_DECIMAL(start) || IS_PERCENT(start)) s = VAL_DECIMAL(start);
else { Trap_Arg(start); DEAD_END_VOID; }
if (IS_INTEGER(end)) e = cast(REBDEC, VAL_INT64(end));
else if (IS_DECIMAL(end) || IS_PERCENT(end)) e = VAL_DECIMAL(end);
else { Trap_Arg(end); DEAD_END_VOID; }
if (IS_INTEGER(incr)) i = cast(REBDEC, VAL_INT64(incr));
else if (IS_DECIMAL(incr) || IS_PERCENT(incr)) i = VAL_DECIMAL(incr);
else { Trap_Arg(incr); DEAD_END_VOID; }
VAL_SET(var, REB_DECIMAL);
SET_NONE(out); // Default result to NONE if the loop does not run
for (; (i > 0.0) ? s <= e : s >= e; s += i) {
VAL_DECIMAL(var) = s;
if (!DO_BLOCK(out, body, 0) && Check_Error(out) >= 0) break;
if (!IS_DECIMAL(var)) Trap_Type(var);
s = VAL_DECIMAL(var);
}
}
*/ REBINT Get_Num_Arg(REBVAL *val)
/*
** Get the amount to skip or pick.
** Allow multiple types. Throw error if not valid.
** Note that the result is one-based.
**
***********************************************************************/
{
REBINT n;
if (IS_INTEGER(val)) {
if (VAL_INT64(val) > (i64)MAX_I32 || VAL_INT64(val) < (i64)MIN_I32)
Trap_Range(val);
n = VAL_INT32(val);
}
else if (IS_DECIMAL(val) || IS_PERCENT(val)) {
if (VAL_DECIMAL(val) > MAX_I32 || VAL_DECIMAL(val) < MIN_I32)
Trap_Range(val);
n = (REBINT)VAL_DECIMAL(val);
}
else if (IS_LOGIC(val)) n = (VAL_LOGIC(val) ? 1 : 2);
else Trap_Arg(val);
return n;
}
*/ static void Loop_Number(REBVAL *var, REBSER* body, REBVAL *start, REBVAL *end, REBVAL *incr)
/*
***********************************************************************/
{
REBVAL *result;
REBDEC s;
REBDEC e;
REBDEC i;
if (IS_INTEGER(start)) s = (REBDEC)VAL_INT64(start);
else if (IS_DECIMAL(start) || IS_PERCENT(start)) s = VAL_DECIMAL(start);
else Trap_Arg(start);
if (IS_INTEGER(end)) e = (REBDEC)VAL_INT64(end);
else if (IS_DECIMAL(end) || IS_PERCENT(end)) e = VAL_DECIMAL(end);
else Trap_Arg(end);
if (IS_INTEGER(incr)) i = (REBDEC)VAL_INT64(incr);
else if (IS_DECIMAL(incr) || IS_PERCENT(incr)) i = VAL_DECIMAL(incr);
else Trap_Arg(incr);
VAL_SET(var, REB_DECIMAL);
for (; (i > 0.0) ? s <= e : s >= e; s += i) {
VAL_DECIMAL(var) = s;
result = Do_Blk(body, 0);
if (THROWN(result) && Check_Error(result) >= 0) break;
if (!IS_DECIMAL(var)) Trap_Type(var);
s = VAL_DECIMAL(var);
}
}
*/ REBINT Int32s(REBVAL *val, REBINT sign)
/*
** Get integer as positive, negative 32 bit value.
** Sign field can be
** 0: >= 0
** 1: > 0
** -1: < 0
**
***********************************************************************/
{
REBINT n = 0;
if (IS_DECIMAL(val)) {
if (VAL_DECIMAL(val) > MAX_I32 || VAL_DECIMAL(val) < MIN_I32)
Trap_Range(val);
n = (REBINT)VAL_DECIMAL(val);
} else {
if (VAL_INT64(val) > (i64)MAX_I32 || VAL_INT64(val) < (i64)MIN_I32)
Trap_Range(val);
n = VAL_INT32(val);
}
// More efficient to use positive sense:
if (
(sign == 0 && n >= 0) ||
(sign > 0 && n > 0) ||
(sign < 0 && n < 0)
)
return n;
Trap_Range(val);
return 0;
}
*/ REBI64 Int64s(REBVAL *val, REBINT sign)
/*
** Get integer as positive, negative 64 bit value.
** Sign field can be
** 0: >= 0
** 1: > 0
** -1: < 0
**
***********************************************************************/
{
REBI64 n;
if (IS_DECIMAL(val)) {
if (VAL_DECIMAL(val) > MAX_I64 || VAL_DECIMAL(val) < MIN_I64)
Trap_Range(val);
n = (REBI64)VAL_DECIMAL(val);
} else {
n = VAL_INT64(val);
}
// More efficient to use positive sense:
if (
(sign == 0 && n >= 0) ||
(sign > 0 && n > 0) ||
(sign < 0 && n < 0)
)
return n;
Trap_Range(val);
DEAD_END;
}
*/ static int Compare_Call(const void *v1, const void *v2)
/*
***********************************************************************/
{
REBVAL *val;
if (sort_flags.reverse)
val = Apply_Func(0, sort_flags.compare, v1, v2, 0);
else
val = Apply_Func(0, sort_flags.compare, v2, v1, 0);
if (IS_LOGIC(val)) {
if (IS_TRUE(val)) return 1;
return -1;
}
if (IS_INTEGER(val)) {
if (VAL_INT64(val) > 0) return 1;
if (VAL_INT64(val) == 0) return 0;
return -1;
}
if (IS_DECIMAL(val)) {
if (VAL_DECIMAL(val) > 0) return 1;
if (VAL_DECIMAL(val) == 0) return 0;
return -1;
}
if (IS_TRUE(val)) return 1;
return -1;
}
//
// Int32s: C
//
// Get integer as positive, negative 32 bit value.
// Sign field can be
// 0: >= 0
// 1: > 0
// -1: < 0
//
REBINT Int32s(const REBVAL *val, REBINT sign)
{
REBINT n = 0;
if (IS_DECIMAL(val)) {
if (VAL_DECIMAL(val) > MAX_I32 || VAL_DECIMAL(val) < MIN_I32)
fail (Error_Out_Of_Range(val));
n = (REBINT)VAL_DECIMAL(val);
} else {
if (VAL_INT64(val) > (i64)MAX_I32 || VAL_INT64(val) < (i64)MIN_I32)
fail (Error_Out_Of_Range(val));
n = VAL_INT32(val);
}
// More efficient to use positive sense:
if (
(sign == 0 && n >= 0) ||
(sign > 0 && n > 0) ||
(sign < 0 && n < 0)
)
return n;
fail (Error_Out_Of_Range(val));
}
//
// MT_Pair: C
//
REBFLG MT_Pair(REBVAL *out, REBVAL *data, enum Reb_Kind type)
{
REBD32 x;
REBD32 y;
if (IS_PAIR(data)) {
*out = *data;
return TRUE;
}
if (!IS_BLOCK(data)) return FALSE;
data = VAL_ARRAY_AT(data);
if (IS_INTEGER(data)) x = (REBD32)VAL_INT64(data);
else if (IS_DECIMAL(data)) x = (REBD32)VAL_DECIMAL(data);
else return FALSE;
data++;
if (IS_END(data))
return FALSE;
if (IS_INTEGER(data)) y = (REBD32)VAL_INT64(data);
else if (IS_DECIMAL(data)) y = (REBD32)VAL_DECIMAL(data);
else return FALSE;
VAL_RESET_HEADER(out, REB_PAIR);
VAL_PAIR_X(out) = x;
VAL_PAIR_Y(out) = y;
return TRUE;
}
*/ REBFLG MT_Pair(REBVAL *out, REBVAL *data, REBCNT type)
/*
***********************************************************************/
{
REBD32 x;
REBD32 y;
if (IS_PAIR(data)) {
*out = *data;
return TRUE;
}
if (!IS_BLOCK(data)) return FALSE;
data = VAL_BLK_DATA(data);
if (IS_INTEGER(data)) x = (REBD32)VAL_INT64(data);
else if (IS_DECIMAL(data)) x = (REBD32)VAL_DECIMAL(data);
else return FALSE;
data++;
if (IS_INTEGER(data)) y = (REBD32)VAL_INT64(data);
else if (IS_DECIMAL(data)) y = (REBD32)VAL_DECIMAL(data);
else return FALSE;
VAL_SET(out, REB_PAIR);
VAL_PAIR_X(out) = x;
VAL_PAIR_Y(out) = y;
return TRUE;
}
//
// Int32: C
//
REBINT Int32(const REBVAL *val)
{
REBINT n = 0;
if (IS_DECIMAL(val)) {
if (VAL_DECIMAL(val) > MAX_I32 || VAL_DECIMAL(val) < MIN_I32)
fail (Error_Out_Of_Range(val));
n = (REBINT)VAL_DECIMAL(val);
} else {
if (VAL_INT64(val) > (i64)MAX_I32 || VAL_INT64(val) < (i64)MIN_I32)
fail (Error_Out_Of_Range(val));
n = VAL_INT32(val);
}
return n;
}
static void Get_Math_Arg_For_Pair(
REBDEC *x_out,
REBDEC *y_out,
REBVAL *arg,
REBSYM action
){
switch (VAL_TYPE(arg)) {
case REB_PAIR:
*x_out = VAL_PAIR_X(arg);
*y_out = VAL_PAIR_Y(arg);
break;
case REB_INTEGER:
*x_out = *y_out = cast(REBDEC, VAL_INT64(arg));
break;
case REB_DECIMAL:
case REB_PERCENT:
*x_out = *y_out = cast(REBDEC, VAL_DECIMAL(arg));
break;
default:
fail (Error_Math_Args(REB_PAIR, action));
}
}
*/ REBINT PD_Pair(REBPVS *pvs)
/*
***********************************************************************/
{
REBVAL *sel;
REBVAL *val;
REBINT n = 0;
REBD32 dec;
if (IS_WORD(sel = pvs->select)) {
if (VAL_WORD_CANON(sel) == SYM_X) n = 1;
else if (VAL_WORD_CANON(sel) == SYM_Y) n = 2;
else return PE_BAD_SELECT;
}
else if (IS_INTEGER(sel)) {
n = Int32(sel);
if (n != 1 && n !=2) return PE_BAD_SELECT;
}
else
return PE_BAD_SELECT;
if (NZ(val = pvs->setval)) {
if (IS_INTEGER(val)) dec = (REBD32)VAL_INT64(val);
else if (IS_DECIMAL(val)) dec = (REBD32)VAL_DECIMAL(val);
else return PE_BAD_SET;
if (n == 1) VAL_PAIR_X(pvs->value) = dec;
else VAL_PAIR_Y(pvs->value) = dec;
} else {
dec = (n == 1 ? VAL_PAIR_X(pvs->value) : VAL_PAIR_Y(pvs->value));
SET_DECIMAL(pvs->store, dec);
return PE_USE;
}
return PE_OK;
}
*/ REBINT Int32(REBVAL *val)
/*
***********************************************************************/
{
REBINT n = 0;
if (IS_DECIMAL(val)) {
if (VAL_DECIMAL(val) > MAX_I32 || VAL_DECIMAL(val) < MIN_I32)
Trap_Range(val);
n = (REBINT)VAL_DECIMAL(val);
} else {
if (VAL_INT64(val) > (i64)MAX_I32 || VAL_INT64(val) < (i64)MIN_I32)
Trap_Range(val);
n = VAL_INT32(val);
}
return n;
}
*/ static void Loop_Number(REBVAL *out, REBVAL *var, REBSER* body, REBVAL *start, REBVAL *end, REBVAL *incr)
/*
***********************************************************************/
{
REBDEC s;
REBDEC e;
REBDEC i;
if (IS_INTEGER(start))
s = cast(REBDEC, VAL_INT64(start));
else if (IS_DECIMAL(start) || IS_PERCENT(start))
s = VAL_DECIMAL(start);
else
raise Error_Invalid_Arg(start);
if (IS_INTEGER(end))
e = cast(REBDEC, VAL_INT64(end));
else if (IS_DECIMAL(end) || IS_PERCENT(end))
e = VAL_DECIMAL(end);
else
raise Error_Invalid_Arg(end);
if (IS_INTEGER(incr))
i = cast(REBDEC, VAL_INT64(incr));
else if (IS_DECIMAL(incr) || IS_PERCENT(incr))
i = VAL_DECIMAL(incr);
else
raise Error_Invalid_Arg(incr);
VAL_SET(var, REB_DECIMAL);
SET_NONE(out); // Default result to NONE if the loop does not run
for (; (i > 0.0) ? s <= e : s >= e; s += i) {
VAL_DECIMAL(var) = s;
if (Do_Block_Throws(out, body, 0)) {
if (Loop_Throw_Should_Return(out)) break;
}
if (!IS_DECIMAL(var)) raise Error_Has_Bad_Type(var);
s = VAL_DECIMAL(var);
}
}
*/ REBDEC Dec64(REBVAL *val)
/*
***********************************************************************/
{
if (IS_DECIMAL(val) || IS_PERCENT(val)) return VAL_DECIMAL(val);
if (IS_INTEGER(val)) return (REBDEC)VAL_INT64(val);
if (IS_MONEY(val)) return deci_to_decimal(VAL_DECI(val));
Trap_Arg(val);
return 0;
}
*/ REBI64 Int64(REBVAL *val)
/*
***********************************************************************/
{
if (IS_INTEGER(val)) return VAL_INT64(val);
if (IS_DECIMAL(val) || IS_PERCENT(val)) return (REBI64)VAL_DECIMAL(val);
if (IS_MONEY(val)) return deci_to_int(VAL_DECI(val));
Trap_Arg(val);
return 0;
}
*/ REBINT CT_Decimal(REBVAL *a, REBVAL *b, REBINT mode)
/*
***********************************************************************/
{
if (mode >= 0) {
if (mode <= 1) return almost_equal(VAL_DECIMAL(a), VAL_DECIMAL(b), 10);
if (mode == 2) return almost_equal(VAL_DECIMAL(a), VAL_DECIMAL(b), 0);
return VAL_INT64(a) == VAL_INT64(b); // bits are identical
}
if (mode == -1) return VAL_DECIMAL(a) >= VAL_DECIMAL(b);
return VAL_DECIMAL(a) > VAL_DECIMAL(b);
}
*/ REBFLG Get_Logic_Arg(REBVAL *arg)
/*
***********************************************************************/
{
if (IS_NONE(arg)) return 0;
if (IS_INTEGER(arg)) return (VAL_INT64(arg) != 0);
if (IS_LOGIC(arg)) return (VAL_LOGIC(arg) != 0);
if (IS_DECIMAL(arg) || IS_PERCENT(arg)) return (VAL_DECIMAL(arg) != 0.0);
Trap_Arg(arg);
DEAD_END;
}
//
// 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));
}
//
// Get_Num_From_Arg: C
//
// Get the amount to skip or pick.
// Allow multiple types. Throw error if not valid.
// Note that the result is one-based.
//
REBINT Get_Num_From_Arg(const REBVAL *val)
{
REBINT n;
if (IS_INTEGER(val)) {
if (VAL_INT64(val) > (i64)MAX_I32 || VAL_INT64(val) < (i64)MIN_I32)
fail (Error_Out_Of_Range(val));
n = VAL_INT32(val);
}
else if (IS_DECIMAL(val) || IS_PERCENT(val)) {
if (VAL_DECIMAL(val) > MAX_I32 || VAL_DECIMAL(val) < MIN_I32)
fail (Error_Out_Of_Range(val));
n = (REBINT)VAL_DECIMAL(val);
}
else if (IS_LOGIC(val))
n = (VAL_LOGIC(val) ? 1 : 2);
else
fail (Error_Invalid_Arg(val));
return n;
}
//
// CT_Decimal: C
//
REBINT CT_Decimal(const RELVAL *a, const RELVAL *b, REBINT mode)
{
if (mode >= 0) {
if (mode == 0)
return almost_equal(VAL_DECIMAL(a), VAL_DECIMAL(b), 10) ? 1 : 0;
return almost_equal(VAL_DECIMAL(a), VAL_DECIMAL(b), 0) ? 1 : 0;
}
if (mode == -1)
return (VAL_DECIMAL(a) >= VAL_DECIMAL(b)) ? 1 : 0;
return (VAL_DECIMAL(a) > VAL_DECIMAL(b)) ? 1 : 0;
}
//
// Int64s: C
//
// Get integer as positive, negative 64 bit value.
// Sign field can be
// 0: >= 0
// 1: > 0
// -1: < 0
//
REBI64 Int64s(const REBVAL *val, REBINT sign)
{
REBI64 n;
if (IS_DECIMAL(val)) {
if (VAL_DECIMAL(val) > MAX_I64 || VAL_DECIMAL(val) < MIN_I64)
fail (Error_Out_Of_Range(val));
n = (REBI64)VAL_DECIMAL(val);
} else {
n = VAL_INT64(val);
}
// More efficient to use positive sense:
if (
(sign == 0 && n >= 0) ||
(sign > 0 && n > 0) ||
(sign < 0 && n < 0)
)
return n;
fail (Error_Out_Of_Range(val));
}
//
// Poke_Vector_Fail_If_Locked: C
//
void Poke_Vector_Fail_If_Locked(
REBVAL *value,
const REBVAL *picker,
const REBVAL *poke
) {
REBSER *vect = VAL_SERIES(value);
FAIL_IF_LOCKED_SERIES(vect);
REBINT n;
if (IS_INTEGER(picker) || IS_DECIMAL(picker))
n = Int32(picker);
else
fail (Error_Invalid_Arg(picker));
n += VAL_INDEX(value);
if (n <= 0 || cast(REBCNT, n) > SER_LEN(vect))
fail (Error_Out_Of_Range(picker));
REBYTE *vp = SER_DATA_RAW(vect);
REBINT bits = VECT_TYPE(vect);
REBI64 i;
REBDEC f;
if (IS_INTEGER(poke)) {
i = VAL_INT64(poke);
if (bits > VTUI64)
f = cast(REBDEC, i);
else {
// !!! REVIEW: f was not set in this case; compiler caught the
// unused parameter. So fill with distinctive garbage to make it
// easier to search for if it ever is.
f = -646.699;
}
}
else if (IS_DECIMAL(poke)) {
f = VAL_DECIMAL(poke);
if (bits <= VTUI64)
i = cast(REBINT, f);
}
else fail (Error_Invalid_Arg(poke));
set_vect(bits, vp, n - 1, i, f);
}
//
// PD_Pair: C
//
REBINT PD_Pair(REBPVS *pvs)
{
const REBVAL *sel = pvs->selector;
REBINT n = 0;
REBDEC dec;
if (IS_WORD(sel)) {
if (VAL_WORD_SYM(sel) == SYM_X)
n = 1;
else if (VAL_WORD_SYM(sel) == SYM_Y)
n = 2;
else
fail (Error_Bad_Path_Select(pvs));
}
else if (IS_INTEGER(sel)) {
n = Int32(sel);
if (n != 1 && n != 2)
fail (Error_Bad_Path_Select(pvs));
}
else fail (Error_Bad_Path_Select(pvs));
if (pvs->opt_setval) {
const REBVAL *setval = pvs->opt_setval;
if (IS_INTEGER(setval))
dec = cast(REBDEC, VAL_INT64(setval));
else if (IS_DECIMAL(setval))
dec = VAL_DECIMAL(setval);
else
fail (Error_Bad_Path_Set(pvs));
if (n == 1)
VAL_PAIR_X(pvs->value) = dec;
else
VAL_PAIR_Y(pvs->value) = dec;
}
else {
dec = (n == 1 ? VAL_PAIR_X(pvs->value) : VAL_PAIR_Y(pvs->value));
SET_DECIMAL(pvs->store, dec);
return PE_USE_STORE;
}
return PE_OK;
}
*/ static REBFLG Set_Pair(REBXYF *pair, REBVAL *val)
/*
***********************************************************************/
{
if (IS_PAIR(val)) {
pair->x = VAL_PAIR_X(val);
pair->y = VAL_PAIR_Y(val);
}
else if (IS_INTEGER(val)) {
pair->x = pair->y = (REBD32)VAL_INT64(val);
}
else if (IS_DECIMAL(val)) {
pair->x = pair->y = (REBD32)VAL_DECIMAL(val);
}
else
return FALSE;
return TRUE;
}
void Set_Vector_Row(REBSER *ser, REBVAL *blk)
{
REBCNT idx = VAL_INDEX(blk);
REBCNT len = VAL_LEN_AT(blk);
RELVAL *val;
REBCNT n = 0;
REBCNT bits = VECT_TYPE(ser);
REBI64 i = 0;
REBDEC f = 0;
if (IS_BLOCK(blk)) {
val = VAL_ARRAY_AT(blk);
for (; NOT_END(val); val++) {
if (IS_INTEGER(val)) {
i = VAL_INT64(val);
if (bits > VTUI64) f = (REBDEC)(i);
}
else if (IS_DECIMAL(val)) {
f = VAL_DECIMAL(val);
if (bits <= VTUI64) i = (REBINT)(f);
}
else fail (Error_Invalid_Arg_Core(val, VAL_SPECIFIER(blk)));
//if (n >= ser->tail) Expand_Vector(ser);
set_vect(bits, SER_DATA_RAW(ser), n++, i, f);
}
}
else {
REBYTE *data = VAL_BIN_AT(blk);
for (; len > 0; len--, idx++) {
set_vect(
bits, SER_DATA_RAW(ser), n++, cast(REBI64, data[idx]), f
);
}
}
}
*/ REBINT PD_Time(REBPVS *pvs)
/*
***********************************************************************/
{
REBVAL *val;
REBINT i;
REBINT n;
REBDEC f;
REB_TIMEF tf;
if (IS_WORD(pvs->select)) {
switch (VAL_WORD_CANON(pvs->select)) {
case SYM_HOUR: i = 0; break;
case SYM_MINUTE: i = 1; break;
case SYM_SECOND: i = 2; break;
default: return PE_BAD_SELECT;
}
}
else if (IS_INTEGER(pvs->select))
i = VAL_INT32(pvs->select) - 1;
else
return PE_BAD_SELECT;
Split_Time(VAL_TIME(pvs->value), &tf); // loses sign
if (!(val = pvs->setval)) {
val = pvs->store;
switch(i) {
case 0: // hours
SET_INTEGER(val, tf.h);
break;
case 1:
SET_INTEGER(val, tf.m);
break;
case 2:
if (tf.n == 0)
SET_INTEGER(val, tf.s);
else
SET_DECIMAL(val, (REBDEC)tf.s + (tf.n * NANO));
break;
default:
return PE_NONE;
}
return PE_USE;
} else {
if (IS_INTEGER(val) || IS_DECIMAL(val)) n = Int32s(val, 0);
else if (IS_NONE(val)) n = 0;
else return PE_BAD_SET;
switch(i) {
case 0:
tf.h = n;
break;
case 1:
tf.m = n;
break;
case 2:
if (IS_DECIMAL(val)) {
f = VAL_DECIMAL(val);
if (f < 0.0) Trap_Range_DEAD_END(val);
tf.s = (REBINT)f;
tf.n = (REBINT)((f - tf.s) * SEC_SEC);
}
else {
tf.s = n;
tf.n = 0;
}
break;
default:
return PE_BAD_SELECT;
}
VAL_TIME(pvs->value) = Join_Time(&tf, FALSE);
return PE_OK;
}
}
*/ REBI64 Make_Time(REBVAL *val)
/*
** Returns NO_TIME if error.
**
***********************************************************************/
{
REBI64 secs = 0;
if (IS_TIME(val)) {
secs = VAL_TIME(val);
}
else if (IS_STRING(val)) {
REBYTE *bp;
REBCNT len;
bp = Qualify_String(val, 30, &len, FALSE); // can trap, ret diff str
if (!Scan_Time(bp, len, val)) goto no_time;
secs = VAL_TIME(val);
}
else if (IS_INTEGER(val)) {
if (VAL_INT64(val) < -MAX_SECONDS || VAL_INT64(val) > MAX_SECONDS)
Trap_Range_DEAD_END(val);
secs = VAL_INT64(val) * SEC_SEC;
}
else if (IS_DECIMAL(val)) {
if (VAL_DECIMAL(val) < (REBDEC)(-MAX_SECONDS) || VAL_DECIMAL(val) > (REBDEC)MAX_SECONDS)
Trap_Range_DEAD_END(val);
secs = DEC_TO_SECS(VAL_DECIMAL(val));
}
else if (ANY_BLOCK(val) && VAL_BLK_LEN(val) <= 3) {
REBFLG neg = FALSE;
REBI64 i;
val = VAL_BLK_DATA(val);
if (!IS_INTEGER(val)) goto no_time;
i = Int32(val);
if (i < 0) i = -i, neg = TRUE;
secs = i * 3600;
if (secs > MAX_SECONDS) goto no_time;
if (NOT_END(++val)) {
if (!IS_INTEGER(val)) goto no_time;
if ((i = Int32(val)) < 0) goto no_time;
secs += i * 60;
if (secs > MAX_SECONDS) goto no_time;
if (NOT_END(++val)) {
if (IS_INTEGER(val)) {
if ((i = Int32(val)) < 0) goto no_time;
secs += i;
if (secs > MAX_SECONDS) goto no_time;
}
else if (IS_DECIMAL(val)) {
if (secs + (REBI64)VAL_DECIMAL(val) + 1 > MAX_SECONDS) goto no_time;
// added in below
}
else goto no_time;
}
}
secs *= SEC_SEC;
if (IS_DECIMAL(val)) secs += DEC_TO_SECS(VAL_DECIMAL(val));
if (neg) secs = -secs;
}
else
no_time: return NO_TIME;
return secs;
}
*/ void Mold_Value(REB_MOLD *mold, REBVAL *value, REBFLG molded)
/*
** Mold or form any value to string series tail.
**
***********************************************************************/
{
REBYTE buf[60];
REBINT len;
REBSER *ser = mold->series;
CHECK_STACK(&len);
ASSERT2(SERIES_WIDE(mold->series) == sizeof(REBUNI), RP_BAD_SIZE);
ASSERT2(ser, RP_NO_BUFFER);
// Special handling of string series: {
if (ANY_STR(value) && !IS_TAG(value)) {
// Forming a string:
if (!molded) {
Insert_String(ser, -1, VAL_SERIES(value), VAL_INDEX(value), VAL_LEN(value), 0);
return;
}
// Special format for ALL string series when not at head:
if (GET_MOPT(mold, MOPT_MOLD_ALL) && VAL_INDEX(value) != 0) {
Mold_All_String(value, mold);
return;
}
}
switch (VAL_TYPE(value)) {
case REB_NONE:
Emit(mold, "+N", SYM_NONE);
break;
case REB_LOGIC:
// if (!molded || !VAL_LOGIC_WORDS(value) || !GET_MOPT(mold, MOPT_MOLD_ALL))
Emit(mold, "+N", VAL_LOGIC(value) ? SYM_TRUE : SYM_FALSE);
// else
// Mold_Logic(mold, value);
break;
case REB_INTEGER:
len = Emit_Integer(buf, VAL_INT64(value));
goto append;
case REB_DECIMAL:
case REB_PERCENT:
len = Emit_Decimal(buf, VAL_DECIMAL(value), IS_PERCENT(value)?DEC_MOLD_PERCENT:0,
Punctuation[GET_MOPT(mold, MOPT_COMMA_PT) ? PUNCT_COMMA : PUNCT_DOT], mold->digits);
goto append;
case REB_MONEY:
len = Emit_Money(value, buf, mold->opts);
goto append;
case REB_CHAR:
Mold_Uni_Char(ser, VAL_CHAR(value), (REBOOL)molded, (REBOOL)GET_MOPT(mold, MOPT_MOLD_ALL));
break;
case REB_PAIR:
len = Emit_Decimal(buf, VAL_PAIR_X(value), DEC_MOLD_MINIMAL, Punctuation[PUNCT_DOT], mold->digits/2);
Append_Bytes_Len(ser, buf, len);
Append_Byte(ser, 'x');
len = Emit_Decimal(buf, VAL_PAIR_Y(value), DEC_MOLD_MINIMAL, Punctuation[PUNCT_DOT], mold->digits/2);
Append_Bytes_Len(ser, buf, len);
//Emit(mold, "IxI", VAL_PAIR_X(value), VAL_PAIR_Y(value));
break;
case REB_TUPLE:
len = Emit_Tuple(value, buf);
goto append;
case REB_TIME:
//len = Emit_Time(value, buf, Punctuation[GET_MOPT(mold, MOPT_COMMA_PT) ? PUNCT_COMMA : PUNCT_DOT]);
Emit_Time(mold, value);
break;
case REB_DATE:
Emit_Date(mold, value);
break;
case REB_STRING:
// FORM happens in top section.
Mold_String_Series(value, mold);
break;
case REB_BINARY:
if (GET_MOPT(mold, MOPT_MOLD_ALL) && VAL_INDEX(value) != 0) {
Mold_All_String(value, mold);
return;
}
Mold_Binary(value, mold);
break;
case REB_FILE:
if (VAL_LEN(value) == 0) {
Append_Bytes(ser, "%\"\"");
break;
}
Mold_File(value, mold);
break;
case REB_EMAIL:
case REB_URL:
Mold_Url(value, mold);
break;
case REB_TAG:
if (GET_MOPT(mold, MOPT_MOLD_ALL) && VAL_INDEX(value) != 0) {
Mold_All_String(value, mold);
return;
}
Mold_Tag(value, mold);
break;
// Mold_Issue(value, mold);
// break;
case REB_BITSET:
Pre_Mold(value, mold); // #[bitset! or make bitset!
Mold_Bitset(value, mold);
End_Mold(mold);
break;
case REB_IMAGE:
Pre_Mold(value, mold);
if (!GET_MOPT(mold, MOPT_MOLD_ALL)) {
Append_Byte(ser, '[');
Mold_Image_Data(value, mold);
Append_Byte(ser, ']');
End_Mold(mold);
}
else {
REBVAL val = *value;
VAL_INDEX(&val) = 0; // mold all of it
Mold_Image_Data(&val, mold);
Post_Mold(value, mold);
}
break;
case REB_BLOCK:
case REB_PAREN:
if (!molded)
Form_Block_Series(VAL_SERIES(value), VAL_INDEX(value), mold, 0);
else
Mold_Block(value, mold);
break;
case REB_PATH:
case REB_SET_PATH:
case REB_GET_PATH:
case REB_LIT_PATH:
Mold_Block(value, mold);
break;
case REB_VECTOR:
Mold_Vector(value, mold, molded);
break;
case REB_DATATYPE:
if (!molded)
Emit(mold, "N", VAL_DATATYPE(value) + 1);
else
Emit(mold, "+DN", SYM_DATATYPE_TYPE, VAL_DATATYPE(value) + 1);
break;
case REB_TYPESET:
Mold_Typeset(value, mold, molded);
break;
case REB_WORD:
// This is a high frequency function, so it is optimized.
Append_UTF8(ser, Get_Sym_Name(VAL_WORD_SYM(value)), -1);
break;
case REB_SET_WORD:
Emit(mold, "W:", value);
break;
case REB_GET_WORD:
Emit(mold, ":W", value);
break;
case REB_LIT_WORD:
Emit(mold, "\'W", value);
break;
case REB_REFINEMENT:
Emit(mold, "/W", value);
break;
case REB_ISSUE:
Emit(mold, "#W", value);
break;
case REB_CLOSURE:
case REB_FUNCTION:
case REB_NATIVE:
case REB_ACTION:
case REB_COMMAND:
Mold_Function(value, mold);
break;
case REB_OBJECT:
case REB_MODULE:
case REB_PORT:
if (!molded) Form_Object(value, mold);
else Mold_Object(value, mold);
break;
case REB_TASK:
Mold_Object(value, mold); //// | (1<<MOPT_NO_NONE));
break;
case REB_ERROR:
Mold_Error(value, mold, molded);
break;
case REB_MAP:
Mold_Map(value, mold, molded);
break;
case REB_GOB:
{
REBSER *blk;
Pre_Mold(value, mold);
blk = Gob_To_Block(VAL_GOB(value));
Mold_Block_Series(mold, blk, 0, 0);
End_Mold(mold);
}
break;
case REB_EVENT:
Mold_Event(value, mold);
break;
case REB_REBCODE:
case REB_OP:
case REB_FRAME:
case REB_HANDLE:
case REB_STRUCT:
case REB_LIBRARY:
case REB_UTYPE:
// Value has no printable form, so just print its name.
if (!molded) Emit(mold, "?T?", value);
else Emit(mold, "+T", value);
break;
case REB_END:
case REB_UNSET:
if (molded) Emit(mold, "+T", value);
break;
default:
Crash(RP_DATATYPE+5, VAL_TYPE(value));
}
return;
append:
Append_Bytes_Len(ser, buf, len);
}
static REBOOL assign_scalar(REBSTU *stu,
struct Struct_Field *field,
REBCNT n, /* element index, starting from 0 */
REBVAL *val)
{
u64 i = 0;
double d = 0;
void *data = SERIES_SKIP(STRUCT_DATA_BIN(stu),
STRUCT_OFFSET(stu) + field->offset + n * field->size);
if (field->type == STRUCT_TYPE_REBVAL) {
memcpy(data, val, sizeof(REBVAL));
return TRUE;
}
switch (VAL_TYPE(val)) {
case REB_DECIMAL:
if (!IS_NUMERIC_TYPE(field->type))
raise Error_Has_Bad_Type(val);
d = VAL_DECIMAL(val);
i = (u64) d;
break;
case REB_INTEGER:
if (!IS_NUMERIC_TYPE(field->type))
if (field->type != STRUCT_TYPE_POINTER)
raise Error_Has_Bad_Type(val);
i = (u64) VAL_INT64(val);
d = (double)i;
break;
case REB_STRUCT:
if (STRUCT_TYPE_STRUCT != field->type)
raise Error_Has_Bad_Type(val);
break;
default:
raise Error_Has_Bad_Type(val);
}
switch (field->type) {
case STRUCT_TYPE_INT8:
*(i8*)data = (i8)i;
break;
case STRUCT_TYPE_UINT8:
*(u8*)data = (u8)i;
break;
case STRUCT_TYPE_INT16:
*(i16*)data = (i16)i;
break;
case STRUCT_TYPE_UINT16:
*(u16*)data = (u16)i;
break;
case STRUCT_TYPE_INT32:
*(i32*)data = (i32)i;
break;
case STRUCT_TYPE_UINT32:
*(u32*)data = (u32)i;
break;
case STRUCT_TYPE_INT64:
*(i64*)data = (i64)i;
break;
case STRUCT_TYPE_UINT64:
*(u64*)data = (u64)i;
break;
case STRUCT_TYPE_POINTER:
*cast(void**, data) = cast(void*, cast(REBUPT, i));
break;
case STRUCT_TYPE_FLOAT:
*(float*)data = (float)d;
break;
case STRUCT_TYPE_DOUBLE:
*(double*)data = (double)d;
break;
case STRUCT_TYPE_STRUCT:
if (field->size != VAL_STRUCT_LEN(val))
raise Error_Invalid_Arg(val);
if (same_fields(field->fields, VAL_STRUCT_FIELDS(val))) {
memcpy(data, SERIES_SKIP(VAL_STRUCT_DATA_BIN(val), VAL_STRUCT_OFFSET(val)), field->size);
} else
raise Error_Invalid_Arg(val);
break;
default:
/* should never be here */
return FALSE;
}
return TRUE;
}