*/ void Init_Words(REBFLG only)
/*
** Only flags BIND_Table creation only (for threads).
**
***********************************************************************/
{
REBCNT n = Get_Hash_Prime(WORD_TABLE_SIZE * 4); // extra to reduce rehashing
if (!only) {
// Create the hash for locating words quickly:
// Note that the TAIL is never changed for this series.
PG_Word_Table.hashes = Make_Series(n+1, sizeof(REBCNT), FALSE);
KEEP_SERIES(PG_Word_Table.hashes, "word hashes"); // pointer array
Clear_Series(PG_Word_Table.hashes);
PG_Word_Table.hashes->tail = n;
// The word (symbol) table itself:
PG_Word_Table.series = Make_Block(WORD_TABLE_SIZE);
SET_NONE(BLK_HEAD(PG_Word_Table.series)); // Put a NONE at head.
KEEP_SERIES(PG_Word_Table.series, "word table"); // words are never GC'd
BARE_SERIES(PG_Word_Table.series); // don't bother to GC scan it
PG_Word_Table.series->tail = 1; // prevent the zero case
// A normal char array to hold symbol names:
PG_Word_Names = Make_Binary(6 * WORD_TABLE_SIZE); // average word size
KEEP_SERIES(PG_Word_Names, "word names");
}
// The bind table. Used to cache context indexes for given symbols.
Bind_Table = Make_Series(SERIES_REST(PG_Word_Table.series), 4, FALSE);
KEEP_SERIES(Bind_Table, "bind table"); // numeric table
CLEAR_SERIES(Bind_Table);
Bind_Table->tail = PG_Word_Table.series->tail;
}
*/ REBSER *Copy_Sequence(REBSER *source)
/*
** Copy any series that *isn't* an "array" (such as STRING!,
** BINARY!, BITSET!, VECTOR!...). Includes the terminator.
**
** Use Copy_Array routines (which specify Shallow, Deep, etc.) for
** greater detail needed when expressing intent for Rebol Arrays.
**
** Note: No suitable name for "non-array-series" has been picked.
** "Sequence" is used for now because Copy_Non_Array() doesn't
** look good and lots of things aren't "Rebol Arrays" that aren't
** series. The main idea was just to get rid of the generic
** Copy_Series() routine, which doesn't call any attention
** to the importance of stating one's intentions specifically
** about semantics when copying an array.
**
***********************************************************************/
{
REBCNT len = source->tail + 1;
REBSER *series = Make_Series(len, SERIES_WIDE(source), MKS_NONE);
assert(!Is_Array_Series(source));
memcpy(series->data, source->data, len * SERIES_WIDE(source));
series->tail = source->tail;
return series;
}
*/ void Expand_Hash(REBSER *ser)
/*
** Expand hash series. Clear it but set its tail.
**
***********************************************************************/
{
REBSER oser;
REBSER *nser;
REBINT pnum;
pnum = Get_Hash_Prime(ser->tail+1);
if (!pnum) Trap_Num(RE_SIZE_LIMIT, ser->tail+1);
nser = Make_Series(pnum+1, SERIES_WIDE(ser), TRUE);
LABEL_SERIES(nser, "hash series");
oser = *ser;
*ser = *nser;
ser->info = oser.info;
*nser = oser;
Clear_Series(ser);
ser->tail = pnum;
Free_Series(nser);
}
*/ REBSER *Copy_String(REBSER *src, REBCNT index, REBINT length)
/*
** Copies a portion of any string (byte or unicode).
** Will slim the string, if needed.
**
** The index + length must be in range unsigned int 32.
**
***********************************************************************/
{
REBUNI *up;
REBYTE wide = 1;
REBSER *dst;
REBINT n;
if (length < 0) length = src->tail;
// Can it be slimmed down?
if (!BYTE_SIZE(src)) {
up = UNI_SKIP(src, index);
for (n = 0; n < length; n++)
if (up[n] > 0xff) break;
if (n < length) wide = sizeof(REBUNI);
}
dst = Make_Series(length + 1, wide, MKS_NONE);
Insert_String(dst, 0, src, index, length, TRUE);
SERIES_TAIL(dst) = length;
TERM_SEQUENCE(dst);
return dst;
}
/* set storage memory to external addr: raw_addr */
static void set_ext_storage (REBVAL *out, REBINT raw_size, REBUPT raw_addr)
{
REBSER *data_ser = VAL_STRUCT_DATA_BIN(out);
REBSER *ser = NULL;
if (raw_size >= 0 && raw_size != cast(REBINT, VAL_STRUCT_LEN(out)))
raise Error_0(RE_INVALID_DATA);
ser = Make_Series(
SERIES_LEN(data_ser) + 1, // include term.
SERIES_WIDE(data_ser),
Is_Array_Series(data_ser) ? (MKS_ARRAY | MKS_EXTERNAL) : MKS_EXTERNAL
);
ser->data = (REBYTE*)raw_addr;
VAL_STRUCT_DATA_BIN(out) = ser;
MANAGE_SERIES(ser);
}
*/ REBSER *Make_Unicode(REBCNT length)
/*
** Make a unicode string series. Used for internal strings.
** Add 1 extra for terminator.
**
***********************************************************************/
{
REBSER *series = Make_Series(length + 1, sizeof(REBUNI), MKS_NONE);
LABEL_SERIES(series, "make unicode");
// !!! Clients seem to have different expectations of if `length` is
// total capacity (and the binary should be empty) or actually is
// specifically being preallocated at a fixed length. Until this
// is straightened out, terminate for both possibilities.
UNI_HEAD(series)[length] = 0;
TERM_SEQUENCE(series);
return series;
}
*/ REBSER *Make_Binary(REBCNT length)
/*
** Make a binary string series. For byte, C, and UTF8 strings.
** Add 1 extra for terminator.
**
***********************************************************************/
{
REBSER *series = Make_Series(length + 1, sizeof(REBYTE), MKS_NONE);
LABEL_SERIES(series, "make binary");
// !!! Clients seem to have different expectations of if `length` is
// total capacity (and the binary should be empty) or actually is
// specifically being preallocated at a fixed length. Until this
// is straightened out, terminate for both possibilities.
BIN_DATA(series)[length] = 0;
TERM_SEQUENCE(series);
return series;
}
*/ REBSER *Copy_Sequence_At_Len(REBSER *source, REBCNT index, REBCNT len)
/*
** Copy a subseries out of a series that is not an array.
** Includes the terminator for it.
**
** Use Copy_Array routines (which specify Shallow, Deep, etc.) for
** greater detail needed when expressing intent for Rebol Arrays.
**
***********************************************************************/
{
REBSER *series = Make_Series(len + 1, SERIES_WIDE(source), MKS_NONE);
assert(!Is_Array_Series(source));
memcpy(
series->data,
source->data + index * SERIES_WIDE(source),
(len + 1) * SERIES_WIDE(source)
);
series->tail = len;
return series;
}
//
// 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;
}
*/ REBSER *Copy_Buffer(REBSER *buf, void *end)
/*
** Copy a shared buffer. Set tail and termination.
**
***********************************************************************/
{
REBSER *ser;
REBCNT len;
len = BYTE_SIZE(buf) ? ((REBYTE *)end) - BIN_HEAD(buf)
: ((REBUNI *)end) - UNI_HEAD(buf);
ser = Make_Series(
len + 1,
SERIES_WIDE(buf),
Is_Array_Series(buf) ? MKS_ARRAY : MKS_NONE
);
memcpy(ser->data, buf->data, SERIES_WIDE(buf) * len);
ser->tail = len;
TERM_SERIES(ser);
return ser;
}
*/ REBSER *At_Head(REBVAL *value)
/*
** Return the series for a value, but if it has an index
** offset, return a copy of the series from that position.
** Useful for functions that do not accept index offsets.
**
***********************************************************************/
{
REBCNT len;
REBSER *ser;
REBSER *src = VAL_SERIES(value);
REBCNT wide;
if (VAL_INDEX(value) == 0) return src;
len = VAL_LEN(value);
wide = SERIES_WIDE(src);
ser = Make_Series(len, wide, FALSE);
memcpy(ser->data, src->data + (VAL_INDEX(value) * wide), len * wide);
ser->tail = len;
return ser;
}
*/ 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 get_scalar(const REBSTU *stu,
const struct Struct_Field *field,
REBCNT n, /* element index, starting from 0 */
REBVAL *val)
{
REBYTE *data = SERIES_SKIP(STRUCT_DATA_BIN(stu),
STRUCT_OFFSET(stu) + field->offset + n * field->size);
switch (field->type) {
case STRUCT_TYPE_UINT8:
SET_INTEGER(val, *(u8*)data);
break;
case STRUCT_TYPE_INT8:
SET_INTEGER(val, *(i8*)data);
break;
case STRUCT_TYPE_UINT16:
SET_INTEGER(val, *(u16*)data);
break;
case STRUCT_TYPE_INT16:
SET_INTEGER(val, *(i8*)data);
break;
case STRUCT_TYPE_UINT32:
SET_INTEGER(val, *(u32*)data);
break;
case STRUCT_TYPE_INT32:
SET_INTEGER(val, *(i32*)data);
break;
case STRUCT_TYPE_UINT64:
SET_INTEGER(val, *(u64*)data);
break;
case STRUCT_TYPE_INT64:
SET_INTEGER(val, *(i64*)data);
break;
case STRUCT_TYPE_FLOAT:
SET_DECIMAL(val, *(float*)data);
break;
case STRUCT_TYPE_DOUBLE:
SET_DECIMAL(val, *(double*)data);
break;
case STRUCT_TYPE_POINTER:
SET_INTEGER(val, cast(REBUPT, *cast(void**, data)));
break;
case STRUCT_TYPE_STRUCT:
{
SET_TYPE(val, REB_STRUCT);
VAL_STRUCT_FIELDS(val) = field->fields;
VAL_STRUCT_SPEC(val) = field->spec;
VAL_STRUCT_DATA(val) = Make_Series(
1, sizeof(struct Struct_Data), MKS_NONE
);
MANAGE_SERIES(VAL_STRUCT_DATA(val));
VAL_STRUCT_DATA_BIN(val) = STRUCT_DATA_BIN(stu);
VAL_STRUCT_OFFSET(val) = data - SERIES_DATA(VAL_STRUCT_DATA_BIN(val));
VAL_STRUCT_LEN(val) = field->size;
}
break;
case STRUCT_TYPE_REBVAL:
memcpy(val, data, sizeof(REBVAL));
break;
default:
/* should never be here */
return FALSE;
}
return TRUE;
}
*/ static void Insert_Gobs(REBGOB *gob, REBVAL *arg, REBCNT index, REBCNT len, REBFLG change)
/*
** Insert one or more gobs into a pane at the given index.
** If index >= tail, an append occurs. Each gob has its parent
** gob field set. (Call Detach_Gobs() before inserting.)
**
***********************************************************************/
{
REBGOB **ptr;
REBCNT n, count;
REBVAL *val, *sarg;
REBINT i;
// Verify they are gobs:
sarg = arg;
for (n = count = 0; n < len; n++, val++) {
val = arg++;
if (IS_WORD(val)) val = Get_Var(val);
if (IS_GOB(val)) {
count++;
if (GOB_PARENT(VAL_GOB(val))) {
// Check if inserting into same parent:
i = -1;
if (GOB_PARENT(VAL_GOB(val)) == gob) {
i = Find_Gob(gob, VAL_GOB(val));
if (i > 0 && i == (REBINT)index-1) { // a no-op
SET_GOB_STATE(VAL_GOB(val), GOBS_NEW);
return;
}
}
Detach_Gob(VAL_GOB(val));
if ((REBINT)index > i) index--;
}
}
}
arg = sarg;
// Create or expand the pane series:
if (!GOB_PANE(gob)) {
GOB_PANE(gob) = Make_Series(count, sizeof(REBGOB*), 0);
LABEL_SERIES(GOB_PANE(gob), "gob pane");
GOB_TAIL(gob) = count;
index = 0;
}
else {
if (change) {
if (index + count > GOB_TAIL(gob)) {
EXPAND_SERIES_TAIL(GOB_PANE(gob), index + count - GOB_TAIL(gob));
}
} else {
Expand_Series(GOB_PANE(gob), index, count);
if (index >= GOB_TAIL(gob)) index = GOB_TAIL(gob)-1;
}
}
ptr = GOB_SKIP(gob, index);
for (n = 0; n < len; n++) {
val = arg++;
if (IS_WORD(val)) val = Get_Var(val);
if (IS_GOB(val)) {
if GOB_PARENT(VAL_GOB(val)) Trap_Temp();
*ptr++ = VAL_GOB(val);
GOB_PARENT(VAL_GOB(val)) = gob;
SET_GOB_STATE(VAL_GOB(val), GOBS_NEW);
}
}
}