//
// Find_Key: C
//
// Returns hash index (either the match or the new one).
// A return of zero is valid (as a hash index);
//
// Wide: width of record (normally 2, a key and a value).
//
// Modes:
// 0 - search, return hash if found or not
// 1 - search, return hash, else return -1 if not
// 2 - search, return hash, else append value and return -1
//
REBINT Find_Key(REBSER *series, REBSER *hser, const REBVAL *key, REBINT wide, REBCNT cased, REBYTE mode)
{
REBCNT *hashes;
REBCNT skip;
REBCNT hash;
REBCNT len;
REBCNT n;
REBVAL *val;
// Compute hash for value:
len = hser->tail;
hash = Hash_Value(key, len);
if (!hash) fail (Error_Has_Bad_Type(key));
// Determine skip and first index:
skip = (len == 0) ? 0 : (hash & 0x0000FFFF) % len;
if (skip == 0) skip = 1;
hash = (len == 0) ? 0 : (hash & 0x00FFFF00) % len;
// Scan hash table for match:
hashes = (REBCNT*)hser->data;
if (ANY_WORD(key)) {
while ((n = hashes[hash])) {
val = BLK_SKIP(series, (n-1) * wide);
if (
ANY_WORD(val) &&
(VAL_WORD_SYM(key) == VAL_WORD_SYM(val) ||
(!cased && VAL_WORD_CANON(key) == VAL_WORD_CANON(val)))
) return hash;
hash += skip;
if (hash >= len) hash -= len;
}
}
else if (ANY_BINSTR(key)) {
while ((n = hashes[hash])) {
val = BLK_SKIP(series, (n-1) * wide);
if (
VAL_TYPE(val) == VAL_TYPE(key)
&& 0 == Compare_String_Vals(key, val, (REBOOL)(!IS_BINARY(key) && !cased))
) return hash;
hash += skip;
if (hash >= len) hash -= len;
}
} else {
while ((n = hashes[hash])) {
val = BLK_SKIP(series, (n-1) * wide);
if (VAL_TYPE(val) == VAL_TYPE(key) && 0 == Cmp_Value(key, val, !cased)) return hash;
hash += skip;
if (hash >= len) hash -= len;
}
}
// Append new value the target series:
if (mode > 1) {
hashes[hash] = SERIES_TAIL(series) + 1;
Append_Values_Len(series, key, wide);
}
return (mode > 0) ? NOT_FOUND : hash;
}
*/ 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);
}
}
*/ static void Loop_Integer(REBVAL *out, REBVAL *var, REBSER* body, REBI64 start, REBI64 end, REBI64 incr)
/*
***********************************************************************/
{
VAL_SET(var, REB_INTEGER);
SET_NONE(out); // Default result to NONE if the loop does not run
while ((incr > 0) ? start <= end : start >= end) {
VAL_INT64(var) = start;
if (Do_Block_Throws(out, body, 0)) {
if (Loop_Throw_Should_Return(out)) break;
}
if (!IS_INTEGER(var)) raise Error_Has_Bad_Type(var);
start = VAL_INT64(var);
if (REB_I64_ADD_OF(start, incr, &start))
raise Error_0(RE_OVERFLOW);
}
}
*/ REBFLG MT_Struct(REBVAL *out, REBVAL *data, enum Reb_Kind type)
/*
* Format:
* make struct! [
* field1 [type1]
* field2: [type2] field2-init-value
* field3: [struct [field1 [type1]]]
* field4: [type1[3]]
* ...
* ]
***********************************************************************/
{
//RL_Print("%s\n", __func__);
REBINT max_fields = 16;
VAL_STRUCT_FIELDS(out) = Make_Series(
max_fields, sizeof(struct Struct_Field), MKS_NONE
);
MANAGE_SERIES(VAL_STRUCT_FIELDS(out));
if (IS_BLOCK(data)) {
//if (Reduce_Block_No_Set_Throws(VAL_SERIES(data), 0, NULL))...
//data = DS_POP;
REBVAL *blk = VAL_BLK_DATA(data);
REBINT field_idx = 0; /* for field index */
u64 offset = 0; /* offset in data */
REBCNT eval_idx = 0; /* for spec block evaluation */
REBVAL *init = NULL; /* for result to save in data */
REBOOL expect_init = FALSE;
REBINT raw_size = -1;
REBUPT raw_addr = 0;
REBCNT alignment = 0;
VAL_STRUCT_SPEC(out) = Copy_Array_Shallow(VAL_SERIES(data));
VAL_STRUCT_DATA(out) = Make_Series(
1, sizeof(struct Struct_Data), MKS_NONE
);
EXPAND_SERIES_TAIL(VAL_STRUCT_DATA(out), 1);
VAL_STRUCT_DATA_BIN(out) = Make_Series(max_fields << 2, 1, MKS_NONE);
VAL_STRUCT_OFFSET(out) = 0;
// We tell the GC to manage this series, but it will not cause a
// synchronous garbage collect. Still, when's the right time?
ENSURE_SERIES_MANAGED(VAL_STRUCT_SPEC(out));
MANAGE_SERIES(VAL_STRUCT_DATA(out));
MANAGE_SERIES(VAL_STRUCT_DATA_BIN(out));
/* set type early such that GC will handle it correctly, i.e, not collect series in the struct */
SET_TYPE(out, REB_STRUCT);
if (IS_BLOCK(blk)) {
parse_attr(blk, &raw_size, &raw_addr);
++ blk;
}
while (NOT_END(blk)) {
REBVAL *inner;
struct Struct_Field *field = NULL;
u64 step = 0;
EXPAND_SERIES_TAIL(VAL_STRUCT_FIELDS(out), 1);
DS_PUSH_NONE;
inner = DS_TOP; /* save in stack so that it won't be GC'ed when MT_Struct is recursively called */
field = (struct Struct_Field *)SERIES_SKIP(VAL_STRUCT_FIELDS(out), field_idx);
field->offset = (REBCNT)offset;
if (IS_SET_WORD(blk)) {
field->sym = VAL_WORD_SYM(blk);
expect_init = TRUE;
if (raw_addr) {
/* initialization is not allowed for raw memory struct */
raise Error_Invalid_Arg(blk);
}
} else if (IS_WORD(blk)) {
field->sym = VAL_WORD_SYM(blk);
expect_init = FALSE;
}
else
raise Error_Has_Bad_Type(blk);
++ blk;
if (!IS_BLOCK(blk))
raise Error_Invalid_Arg(blk);
if (!parse_field_type(field, blk, inner, &init)) { return FALSE; }
++ blk;
STATIC_assert(sizeof(field->size) <= 4);
STATIC_assert(sizeof(field->dimension) <= 4);
step = (u64)field->size * (u64)field->dimension;
if (step > VAL_STRUCT_LIMIT)
raise Error_1(RE_SIZE_LIMIT, out);
EXPAND_SERIES_TAIL(VAL_STRUCT_DATA_BIN(out), step);
if (expect_init) {
REBVAL safe; // result of reduce or do (GC saved during eval)
init = &safe;
if (IS_BLOCK(blk)) {
if (Reduce_Block_Throws(init, VAL_SERIES(blk), 0, FALSE))
raise Error_No_Catch_For_Throw(init);
++ blk;
} else {
DO_NEXT_MAY_THROW(
eval_idx,
init,
VAL_SERIES(data),
blk - VAL_BLK_DATA(data)
);
if (eval_idx == THROWN_FLAG)
raise Error_No_Catch_For_Throw(init);
blk = VAL_BLK_SKIP(data, eval_idx);
}
if (field->array) {
if (IS_INTEGER(init)) { /* interpreted as a C pointer */
void *ptr = cast(void *, cast(REBUPT, VAL_INT64(init)));
/* assuming it's an valid pointer and holding enough space */
memcpy(SERIES_SKIP(VAL_STRUCT_DATA_BIN(out), (REBCNT)offset), ptr, field->size * field->dimension);
} else if (IS_BLOCK(init)) {
REBCNT n = 0;
if (VAL_LEN(init) != field->dimension)
raise Error_Invalid_Arg(init);
/* assign */
for (n = 0; n < field->dimension; n ++) {
if (!assign_scalar(&VAL_STRUCT(out), field, n, VAL_BLK_SKIP(init, n))) {
//RL_Print("Failed to assign element value\n");
goto failed;
}
}
}
else
raise Error_Unexpected_Type(REB_BLOCK, VAL_TYPE(blk));
} else {
/* scalar */
if (!assign_scalar(&VAL_STRUCT(out), field, 0, init)) {
//RL_Print("Failed to assign scalar value\n");
goto failed;
}
}
} else if (raw_addr == 0) {
static REBOOL parse_field_type(struct Struct_Field *field, REBVAL *spec, REBVAL *inner, REBVAL **init)
{
REBVAL *val = VAL_BLK_DATA(spec);
if (IS_WORD(val)){
switch (VAL_WORD_CANON(val)) {
case SYM_UINT8:
field->type = STRUCT_TYPE_UINT8;
field->size = 1;
break;
case SYM_INT8:
field->type = STRUCT_TYPE_INT8;
field->size = 1;
break;
case SYM_UINT16:
field->type = STRUCT_TYPE_UINT16;
field->size = 2;
break;
case SYM_INT16:
field->type = STRUCT_TYPE_INT16;
field->size = 2;
break;
case SYM_UINT32:
field->type = STRUCT_TYPE_UINT32;
field->size = 4;
break;
case SYM_INT32:
field->type = STRUCT_TYPE_INT32;
field->size = 4;
break;
case SYM_UINT64:
field->type = STRUCT_TYPE_UINT64;
field->size = 8;
break;
case SYM_INT64:
field->type = STRUCT_TYPE_INT64;
field->size = 8;
break;
case SYM_FLOAT:
field->type = STRUCT_TYPE_FLOAT;
field->size = 4;
break;
case SYM_DOUBLE:
field->type = STRUCT_TYPE_DOUBLE;
field->size = 8;
break;
case SYM_POINTER:
field->type = STRUCT_TYPE_POINTER;
field->size = sizeof(void*);
break;
case SYM_STRUCT_TYPE:
++ val;
if (IS_BLOCK(val)) {
REBFLG res;
res = MT_Struct(inner, val, REB_STRUCT);
if (!res) {
//RL_Print("Failed to make nested struct!\n");
return FALSE;
}
field->size = SERIES_TAIL(VAL_STRUCT_DATA_BIN(inner));
field->type = STRUCT_TYPE_STRUCT;
field->fields = VAL_STRUCT_FIELDS(inner);
field->spec = VAL_STRUCT_SPEC(inner);
*init = inner; /* a shortcut for struct intialization */
}
else
raise Error_Unexpected_Type(REB_BLOCK, VAL_TYPE(val));
break;
case SYM_REBVAL:
field->type = STRUCT_TYPE_REBVAL;
field->size = sizeof(REBVAL);
break;
default:
raise Error_Has_Bad_Type(val);
}
} else if (IS_STRUCT(val)) { //[b: [struct-a] val-a]
field->size = SERIES_TAIL(VAL_STRUCT_DATA_BIN(val));
field->type = STRUCT_TYPE_STRUCT;
field->fields = VAL_STRUCT_FIELDS(val);
field->spec = VAL_STRUCT_SPEC(val);
*init = val;
}
else
raise Error_Has_Bad_Type(val);
++ val;
if (IS_BLOCK(val)) {// make struct! [a: [int32 [2]] [0 0]]
REBVAL ret;
if (DO_ARRAY_THROWS(&ret, val)) {
// !!! Does not check for thrown cases...what should this
// do in case of THROW, BREAK, QUIT?
raise Error_No_Catch_For_Throw(&ret);
}
if (!IS_INTEGER(&ret))
raise Error_Unexpected_Type(REB_INTEGER, VAL_TYPE(val));
field->dimension = cast(REBCNT, VAL_INT64(&ret));
field->array = TRUE;
++ val;
} else {
field->dimension = 1; /* scalar */
field->array = FALSE;
}
if (NOT_END(val))
raise Error_Has_Bad_Type(val);
return TRUE;
}
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;
}
//
// Find_Entry: C
//
// Try to find the entry in the map. If not found
// and val is SET, create the entry and store the key and
// val.
//
// RETURNS: the index to the VALUE or zero if there is none.
//
static REBCNT Find_Entry(REBSER *series, REBVAL *key, REBVAL *val)
{
REBSER *hser = series->extra.series; // can be null
REBCNT *hashes;
REBCNT hash;
REBVAL *v;
REBCNT n;
if (IS_NONE(key)) return 0;
// We may not be large enough yet for the hash table to
// be worthwhile, so just do a linear search:
if (!hser) {
if (series->tail < MIN_DICT*2) {
v = BLK_HEAD(series);
if (ANY_WORD(key)) {
for (n = 0; n < series->tail; n += 2, v += 2) {
if (
ANY_WORD(v)
&& SAME_SYM(VAL_WORD_SYM(key), VAL_WORD_SYM(v))
) {
if (val) *++v = *val;
return n/2+1;
}
}
}
else if (ANY_BINSTR(key)) {
for (n = 0; n < series->tail; n += 2, v += 2) {
if (VAL_TYPE(key) == VAL_TYPE(v) && 0 == Compare_String_Vals(key, v, (REBOOL)!IS_BINARY(v))) {
if (val)
*++v = *val;
return n/2+1;
}
}
}
else if (IS_INTEGER(key)) {
for (n = 0; n < series->tail; n += 2, v += 2) {
if (IS_INTEGER(v) && VAL_INT64(key) == VAL_INT64(v)) {
if (val) *++v = *val;
return n/2+1;
}
}
}
else if (IS_CHAR(key)) {
for (n = 0; n < series->tail; n += 2, v += 2) {
if (IS_CHAR(v) && VAL_CHAR(key) == VAL_CHAR(v)) {
if (val) *++v = *val;
return n/2+1;
}
}
}
else
fail (Error_Has_Bad_Type(key));
if (!val) return 0;
Append_Value(series, key);
Append_Value(series, val); // does not copy value, e.g. if string
return series->tail/2;
}
// Add hash table:
//Print("hash added %d", series->tail);
series->extra.series = hser = Make_Hash_Sequence(series->tail);
MANAGE_SERIES(hser);
Rehash_Hash(series);
}
// Get hash table, expand it if needed:
if (series->tail > hser->tail/2) {
Expand_Hash(hser); // modifies size value
Rehash_Hash(series);
}
hash = Find_Key(series, hser, key, 2, 0, 0);
hashes = (REBCNT*)hser->data;
n = hashes[hash];
// Just a GET of value:
if (!val) return n;
// Must set the value:
if (n) { // re-set it:
*BLK_SKIP(series, ((n-1)*2)+1) = *val; // set it
return n;
}
// Create new entry:
Append_Value(series, key);
Append_Value(series, val); // does not copy value, e.g. if string
return (hashes[hash] = series->tail/2);
}
*/ REBINT Find_Key(REBSER *series, REBSER *hser, const REBVAL *key, REBINT wide, REBCNT cased, REBYTE mode)
/*
** Returns hash index (either the match or the new one).
** A return of zero is valid (as a hash index);
**
** Wide: width of record (normally 2, a key and a value).
**
** Modes:
** 0 - search, return hash if found or not
** 1 - search, return hash, else return -1 if not
** 2 - search, return hash, else append value and return -1
**
***********************************************************************/
{
REBCNT *hashes;
REBCNT skip;
REBCNT hash;
REBCNT len;
REBCNT n;
REBVAL *val;
// Compute hash for value:
len = hser->tail;
hash = Hash_Value(key, len);
if (!hash) raise Error_Has_Bad_Type(key);
// Determine skip and first index:
skip = (len == 0) ? 0 : (hash & 0x0000FFFF) % len;
if (skip == 0) skip = 1;
hash = (len == 0) ? 0 : (hash & 0x00FFFF00) % len;
// Scan hash table for match:
hashes = (REBCNT*)hser->data;
if (ANY_WORD(key)) {
while ((n = hashes[hash])) {
val = BLK_SKIP(series, (n-1) * wide);
if (
ANY_WORD(val) &&
(VAL_WORD_SYM(key) == VAL_WORD_SYM(val) ||
(!cased && VAL_WORD_CANON(key) == VAL_WORD_CANON(val)))
) return hash;
hash += skip;
if (hash >= len) hash -= len;
}
}
else if (ANY_BINSTR(key)) {
while ((n = hashes[hash])) {
val = BLK_SKIP(series, (n-1) * wide);
if (
VAL_TYPE(val) == VAL_TYPE(key)
&& 0 == Compare_String_Vals(key, val, (REBOOL)(!IS_BINARY(key) && !cased))
) return hash;
hash += skip;
if (hash >= len) hash -= len;
}
} else {
while ((n = hashes[hash])) {
val = BLK_SKIP(series, (n-1) * wide);
if (VAL_TYPE(val) == VAL_TYPE(key) && 0 == Cmp_Value(key, val, !cased)) return hash;
hash += skip;
if (hash >= len) hash -= len;
}
}
// Append new value the target series:
if (mode > 1) {
hashes[hash] = SERIES_TAIL(series) + 1;
Append_Values_Len(series, key, wide);
}
return (mode > 0) ? NOT_FOUND : hash;
}
