示例#1
0
*/	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;
}
示例#2
0
文件: m-series.c 项目: kealist/ren-c
*/	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;
}
示例#3
0
*/	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);
}
示例#4
0
文件: s-make.c 项目: asampal/ren-c
*/	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;
}
示例#5
0
文件: t-struct.c 项目: asampal/ren-c
/* 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);
}
示例#6
0
文件: s-make.c 项目: asampal/ren-c
*/	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;
}
示例#7
0
文件: s-make.c 项目: asampal/ren-c
*/	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;
}
示例#8
0
文件: m-series.c 项目: kealist/ren-c
*/	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;
}
示例#9
0
文件: t-vector.c 项目: rgchris/ren-c
//
//  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;
}
示例#10
0
文件: m-series.c 项目: kealist/ren-c
*/  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;
}
示例#11
0
文件: f-stubs.c 项目: 51weekend/r3
*/	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;
}
示例#12
0
文件: t-struct.c 项目: asampal/ren-c
*/	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) {
示例#13
0
文件: t-struct.c 项目: asampal/ren-c
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;
}
示例#14
0
文件: t-gob.c 项目: xqlab/r3
*/	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);
        }
    }
}