//
// Compare_Vector: C
//
REBINT Compare_Vector(const RELVAL *v1, const RELVAL *v2)
{
REBCNT l1 = VAL_LEN_AT(v1);
REBCNT l2 = VAL_LEN_AT(v2);
REBCNT len = MIN(l1, l2);
REBCNT n;
REBU64 i1;
REBU64 i2;
REBYTE *d1 = SER_DATA_RAW(VAL_SERIES(v1));
REBYTE *d2 = SER_DATA_RAW(VAL_SERIES(v2));
REBCNT b1 = VECT_TYPE(VAL_SERIES(v1));
REBCNT b2 = VECT_TYPE(VAL_SERIES(v2));
if ((b1 >= VTSF08 && b2 < VTSF08) || (b2 >= VTSF08 && b1 < VTSF08))
fail (Error(RE_NOT_SAME_TYPE));
for (n = 0; n < len; n++) {
i1 = get_vect(b1, d1, n + VAL_INDEX(v1));
i2 = get_vect(b2, d2, n + VAL_INDEX(v2));
if (i1 != i2) break;
}
if (n != len) {
if (i1 > i2) return 1;
return -1;
}
return l1 - l2;
}
//
// Dump_Series: C
//
void Dump_Series(REBSER *series, const char *memo)
{
if (!series) return;
Debug_Fmt(
"%s Series %x \"%s\":"
" wide: %2d"
" size: %6d"
" bias: %d"
" tail: %d"
" rest: %d"
" flags: %x",
memo,
series,
"-", // !label
SER_WIDE(series),
SER_TOTAL(series),
SER_BIAS(series),
SER_LEN(series),
SER_REST(series),
series->info.bits // flags + width
);
if (Is_Array_Series(series)) {
Dump_Values(ARR_HEAD(AS_ARRAY(series)), SER_LEN(series));
} else
Dump_Bytes(
SER_DATA_RAW(series),
(SER_LEN(series) + 1) * SER_WIDE(series)
);
}
//
// Pick_Vector: C
//
void Pick_Vector(REBVAL *out, const REBVAL *value, const REBVAL *picker) {
REBSER *vect = VAL_SERIES(value);
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)) {
SET_VOID(out); // out of range of vector data
return;
}
REBYTE *vp = SER_DATA_RAW(vect);
REBINT bits = VECT_TYPE(vect);
if (bits < VTSF08)
SET_INTEGER(out, get_vect(bits, vp, n - 1)); // 64-bit
else {
VAL_RESET_HEADER(out, REB_DECIMAL);
INIT_DECIMAL_BITS(out, get_vect(bits, vp, n - 1)); // 64-bit
}
}
//
// RL_Series: C
//
// Get series information.
//
// Returns:
// Returns information related to a series.
// Arguments:
// series - any series pointer (string or block)
// what - indicates what information to return (see RXI_SER enum)
// Notes:
// Invalid what arg nums will return zero.
//
RL_API REBUPT RL_Series(REBSER *series, REBCNT what)
{
switch (what) {
case RXI_SER_DATA: return cast(REBUPT, SER_DATA_RAW(series));
case RXI_SER_TAIL: return SER_LEN(series);
case RXI_SER_LEFT: return SER_AVAIL(series);
case RXI_SER_SIZE: return SER_REST(series);
case RXI_SER_WIDE: return SER_WIDE(series);
}
return 0;
}
//
// Append_Series: C
//
// Append value(s) onto the tail of a series. The len is
// the number of units (bytes, REBVALS, etc.) of the data,
// and does not include the terminator (which will be added).
// The new tail position will be returned as the result.
// A terminator will be added to the end of the appended data.
//
void Append_Series(REBSER *s, const REBYTE *data, REBCNT len)
{
REBCNT len_old = SER_LEN(s);
REBYTE wide = SER_WIDE(s);
assert(!Is_Array_Series(s));
EXPAND_SERIES_TAIL(s, len);
memcpy(SER_DATA_RAW(s) + (wide * len_old), data, wide * len);
TERM_SERIES(s);
}
//
// Destroy_External_Storage: C
//
// Destroy the external storage pointed by `->data` by calling the routine
// `free_func` if it's not NULL
//
// out Result
// ser The series
// free_func A routine to free the storage, if it's NULL, only mark the
// external storage non-accessible
//
REB_R Destroy_External_Storage(REBVAL *out,
REBSER *ser,
REBVAL *free_func)
{
SET_VOID(out);
if (!GET_SER_FLAG(ser, SERIES_FLAG_EXTERNAL)) {
fail (Error(RE_NO_EXTERNAL_STORAGE));
}
if (!GET_SER_FLAG(ser, SERIES_FLAG_ACCESSIBLE)) {
REBVAL i;
SET_INTEGER(&i, cast(REBUPT, SER_DATA_RAW(ser)));
fail (Error(RE_ALREADY_DESTROYED, &i));
}
CLEAR_SER_FLAG(ser, SERIES_FLAG_ACCESSIBLE);
if (free_func) {
REBVAL safe;
REBARR *array;
REBVAL *elem;
REBOOL threw;
array = Make_Array(2);
MANAGE_ARRAY(array);
PUSH_GUARD_ARRAY(array);
elem = Alloc_Tail_Array(array);
*elem = *free_func;
elem = Alloc_Tail_Array(array);
SET_INTEGER(elem, cast(REBUPT, SER_DATA_RAW(ser)));
threw = Do_At_Throws(&safe, array, 0, SPECIFIED); // 2 non-relative val
DROP_GUARD_ARRAY(array);
if (threw) return R_OUT_IS_THROWN;
}
return R_OUT;
}
//
// Set_Vector_Value: C
//
void Set_Vector_Value(REBVAL *var, REBSER *series, REBCNT index)
{
REBYTE *data = SER_DATA_RAW(series);
REBCNT bits = VECT_TYPE(series);
if (bits >= VTSF08) {
VAL_RESET_HEADER(var, REB_DECIMAL);
INIT_DECIMAL_BITS(var, get_vect(bits, data, index));
}
else {
VAL_RESET_HEADER(var, REB_INTEGER);
VAL_INT64(var) = get_vect(bits, data, index);
}
}
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
);
}
}
}
//
// 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);
}
//
// Insert_Series: C
//
// Insert a series of values (bytes, longs, reb-vals) into the
// series at the given index. Expand it if necessary. Does
// not add a terminator to tail.
//
REBCNT Insert_Series(
REBSER *s,
REBCNT index,
const REBYTE *data,
REBCNT len
) {
if (index > SER_LEN(s))
index = SER_LEN(s);
Expand_Series(s, index, len); // tail += len
memcpy(
SER_DATA_RAW(s) + (SER_WIDE(s) * index),
data,
SER_WIDE(s) * len
);
return index + len;
}
//
// Shuffle_Vector: C
//
void Shuffle_Vector(REBVAL *vect, REBOOL secure)
{
REBCNT n;
REBCNT k;
REBU64 swap;
REBYTE *data = SER_DATA_RAW(VAL_SERIES(vect));
REBCNT type = VECT_TYPE(VAL_SERIES(vect));
REBCNT idx = VAL_INDEX(vect);
// We can do it as INTS, because we just deal with the bits:
if (type == VTSF32) type = VTUI32;
else if (type == VTSF64) type = VTUI64;
for (n = VAL_LEN_AT(vect); n > 1;) {
k = idx + (REBCNT)Random_Int(secure) % n;
n--;
swap = get_vect(type, data, k);
set_vect(type, data, k, get_vect(type, data, n + idx), 0);
set_vect(type, data, n + idx, swap, 0);
}
}
//
// Make_Vector: C
//
// type: the datatype
// sign: signed or unsigned
// dims: number of dimensions
// bits: number of bits per unit (8, 16, 32, 64)
// size: size of array ?
//
REBSER *Make_Vector(REBINT type, REBINT sign, REBINT dims, REBINT bits, REBINT size)
{
REBCNT len;
REBSER *ser;
len = size * dims;
if (len > 0x7fffffff) return 0;
// !!! can width help extend the len?
ser = Make_Series(len + 1, bits/8, MKS_NONE | MKS_POWER_OF_2);
CLEAR(SER_DATA_RAW(ser), (len * bits) / 8);
SET_SERIES_LEN(ser, len);
// Store info about the vector (could be moved to flags if necessary):
switch (bits) {
case 8: bits = 0; break;
case 16: bits = 1; break;
case 32: bits = 2; break;
case 64: bits = 3; break;
}
ser->misc.size = (dims << 8) | (type << 3) | (sign << 2) | bits;
return ser;
}
//
// Vector_To_Array: C
//
// Convert a vector to a block.
//
REBARR *Vector_To_Array(const REBVAL *vect)
{
REBCNT len = VAL_LEN_AT(vect);
REBYTE *data = SER_DATA_RAW(VAL_SERIES(vect));
REBCNT type = VECT_TYPE(VAL_SERIES(vect));
REBARR *array = NULL;
REBCNT n;
RELVAL *val;
if (len <= 0)
fail (Error_Invalid_Arg(vect));
array = Make_Array(len);
val = ARR_HEAD(array);
for (n = VAL_INDEX(vect); n < VAL_LEN_HEAD(vect); n++, val++) {
VAL_RESET_HEADER(val, (type >= VTSF08) ? REB_DECIMAL : REB_INTEGER);
VAL_INT64(val) = get_vect(type, data, n); // can be int or decimal
}
TERM_ARRAY_LEN(array, len);
assert(IS_END(val));
return array;
}
//
// Mold_Vector: C
//
void Mold_Vector(const REBVAL *value, REB_MOLD *mold, REBOOL molded)
{
REBSER *vect = VAL_SERIES(value);
REBYTE *data = SER_DATA_RAW(vect);
REBCNT bits = VECT_TYPE(vect);
// REBCNT dims = vect->size >> 8;
REBCNT len;
REBCNT n;
REBCNT c;
union {REBU64 i; REBDEC d;} v;
REBYTE buf[32];
REBYTE l;
if (GET_MOPT(mold, MOPT_MOLD_ALL)) {
len = VAL_LEN_HEAD(value);
n = 0;
} else {
len = VAL_LEN_AT(value);
n = VAL_INDEX(value);
}
if (molded) {
enum Reb_Kind kind = (bits >= VTSF08) ? REB_DECIMAL : REB_INTEGER;
Pre_Mold(value, mold);
if (!GET_MOPT(mold, MOPT_MOLD_ALL))
Append_Codepoint_Raw(mold->series, '[');
if (bits >= VTUI08 && bits <= VTUI64)
Append_Unencoded(mold->series, "unsigned ");
Emit(
mold,
"N I I [",
Canon(SYM_FROM_KIND(kind)),
bit_sizes[bits & 3],
len
);
if (len)
New_Indented_Line(mold);
}
c = 0;
for (; n < SER_LEN(vect); n++) {
v.i = get_vect(bits, data, n);
if (bits < VTSF08) {
l = Emit_Integer(buf, v.i);
} else {
l = Emit_Decimal(buf, v.d, 0, '.', mold->digits);
}
Append_Unencoded_Len(mold->series, s_cast(buf), l);
if ((++c > 7) && (n + 1 < SER_LEN(vect))) {
New_Indented_Line(mold);
c = 0;
}
else
Append_Codepoint_Raw(mold->series, ' ');
}
if (len) {
//
// remove final space (overwritten with terminator)
//
TERM_UNI_LEN(mold->series, UNI_LEN(mold->series) - 1);
}
if (molded) {
if (len) New_Indented_Line(mold);
Append_Codepoint_Raw(mold->series, ']');
if (!GET_MOPT(mold, MOPT_MOLD_ALL)) {
Append_Codepoint_Raw(mold->series, ']');
}
else {
Post_Mold(value, mold);
}
}
}
