Пример #1
0
*/  REBVAL *Append_Frame(REBSER *frame, REBVAL *word, REBCNT sym)
/*
**      Append a word to the frame word list. Expands the list
**      if necessary. Returns the value cell for the word. (Set to
**      UNSET by default to avoid GC corruption.)
**
**      If word is not NULL, use the word sym and bind the word value,
**      otherwise use sym.
**
***********************************************************************/
{
	REBSER *words = FRM_WORD_SERIES(frame);
	REBVAL *value;

	// Add to word list:
	EXPAND_SERIES_TAIL(words, 1);
	value = BLK_LAST(words);
	Val_Init_Word_Typed(value, REB_WORD, word ? VAL_WORD_SYM(word) : sym, ALL_64);
	BLK_TERM(words);

	// Bind the word to this frame:
	if (word) {
		VAL_WORD_FRAME(word) = frame;
		VAL_WORD_INDEX(word) = frame->tail;
	}

	// Add unset value to frame:
	EXPAND_SERIES_TAIL(frame, 1);
	word = BLK_LAST(frame);
	SET_UNSET(word);
	BLK_TERM(frame);

	return word; // The value cell for word.
}
Пример #2
0
*/  REBSER *Merge_Frames(REBSER *parent1, REBSER *parent2)
/*
**      Create a child frame from two parent frames. Merge common fields.
**      Values from the second parent take precedence.
**
**		Deep copy and rebind the child.
**
***********************************************************************/
{
	REBSER *wrds;
	REBSER *child;
	REBVAL *words;
	REBVAL *value;
	REBCNT n;
	REBINT *binds = WORDS_HEAD(Bind_Table);

	// Merge parent1 and parent2 words.
	// Keep the binding table.
	Collect_Start(BIND_ALL);
	// Setup binding table and BUF_WORDS with parent1 words:
	if (parent1) Collect_Object(parent1);
	// Add parent2 words to binding table and BUF_WORDS:
	Collect_Words(BLK_SKIP(FRM_WORD_SERIES(parent2), 1), BIND_ALL);

	// Allocate child (now that we know the correct size):
	wrds = Copy_Series(BUF_WORDS);
	child = Make_Block(SERIES_TAIL(wrds));
	value = Append_Value(child);
	VAL_SET(value, REB_FRAME);
	VAL_FRM_WORDS(value) = wrds;
	VAL_FRM_SPEC(value) = 0;

	// Copy parent1 values:
	COPY_VALUES(FRM_VALUES(parent1)+1, FRM_VALUES(child)+1, SERIES_TAIL(parent1)-1);

	// Copy parent2 values:
	words = FRM_WORDS(parent2)+1;
	value = FRM_VALUES(parent2)+1;
	for (; NOT_END(words); words++, value++) {
		// no need to search when the binding table is available
		n = binds[VAL_WORD_CANON(words)];
		BLK_HEAD(child)[n] = *value;
	}

	// Terminate the child frame:
	SERIES_TAIL(child) = SERIES_TAIL(wrds);
	BLK_TERM(child);

	// Deep copy the child
	Copy_Deep_Values(child, 1, SERIES_TAIL(child), TS_CLONE);

	// Rebind the child
	Rebind_Block(parent1, child, BLK_SKIP(child, 1), REBIND_FUNC);
	Rebind_Block(parent2, child, BLK_SKIP(child, 1), REBIND_FUNC | REBIND_TABLE);

	// release the bind table 
	Collect_End(wrds);

	return child;
}
Пример #3
0
*/  void Expand_Frame(REBSER *frame, REBCNT delta, REBCNT copy)
/*
**      Expand a frame. Copy words if flagged.
**
***********************************************************************/
{
	REBSER *words = FRM_WORD_SERIES(frame);

	Extend_Series(frame, delta);
	BLK_TERM(frame);

	// Expand or copy WORDS block:
	if (copy) {
		FRM_WORD_SERIES(frame) = Copy_Expand_Block(words, delta);
		BARE_SERIES(FRM_WORD_SERIES(frame));
	} else {
		Extend_Series(words, delta);
		BLK_TERM(words);
	}
}
Пример #4
0
*/  void Expand_Frame(REBSER *frame, REBCNT delta, REBCNT copy)
/*
**      Expand a frame. Copy words if flagged.
**
***********************************************************************/
{
	REBSER *words = FRM_WORD_SERIES(frame);

	Extend_Series(frame, delta);
	BLK_TERM(frame);

	// Expand or copy WORDS block:
	if (copy) {
		REBOOL managed = SERIES_GET_FLAG(FRM_WORD_SERIES(frame), SER_MANAGED);
		FRM_WORD_SERIES(frame) = Copy_Array_Extra_Shallow(words, delta);
		if (managed) MANAGE_SERIES(FRM_WORD_SERIES(frame));
	}
	else {
		Extend_Series(words, delta);
		BLK_TERM(words);
	}
}
Пример #5
0
*/  REBVAL *Append_Frame(REBSER *frame, REBVAL *word, REBCNT sym)
/*
**      Append a word to the frame word list. Expands the list
**      if necessary. Returns the value cell for the word. (Set to
**      UNSET by default to avoid GC corruption.)
**
**      If word is not NULL, use the word sym and bind the word value,
**      otherwise use sym.
**
**      WARNING: Invalidates pointers to values within the frame
**      because the frame block may get expanded. (Use indexes.)
**
***********************************************************************/
{
	REBSER *words = FRM_WORD_SERIES(frame);
	REBVAL *value;

	// Add to word list:
	EXPAND_SERIES_TAIL(words, 1);
	value = BLK_LAST(words);
	if (word) Init_Frame_Word(value, VAL_WORD_SYM(word));
	else Init_Frame_Word(value, sym);
	BLK_TERM(words);

	// Bind the word to this frame:
	if (word) {
		VAL_WORD_FRAME(word) = frame;
		VAL_WORD_INDEX(word) = frame->tail;
	}

	// Add unset value to frame:
	EXPAND_SERIES_TAIL(frame, 1);
	word = BLK_LAST(frame);
	SET_UNSET(word);
	BLK_TERM(frame);

	return word; // The value cell for word.
}
Пример #6
0
*/ void Collect_Words(REBVAL *block, REBFLG modes)
/*
**		The inner recursive loop used for Collect_Words function below.
**
***********************************************************************/
{
	REBINT *binds = WORDS_HEAD(Bind_Table);
	REBVAL *word;
	REBVAL *value;

	for (; NOT_END(block); block++) {
		value = block;
		//if (modes & BIND_GET && IS_GET_WORD(block)) value = Get_Var(block);
		if (ANY_WORD(value)) {
			if (!binds[VAL_WORD_CANON(value)]) {  // only once per word
				if (IS_SET_WORD(value) || modes & BIND_ALL) {
					binds[VAL_WORD_CANON(value)] = SERIES_TAIL(BUF_WORDS);
					EXPAND_SERIES_TAIL(BUF_WORDS, 1);
					word = BLK_LAST(BUF_WORDS);
					VAL_SET(word, VAL_TYPE(value));
					VAL_SET_OPT(word, OPTS_UNWORD);
					VAL_BIND_SYM(word) = VAL_WORD_SYM(value);
					// Allow all datatypes (to start):
					VAL_BIND_TYPESET(word) = ~((TYPESET(REB_END) | TYPESET(REB_UNSET))); // not END or UNSET
				}
			} else {
				// If word duplicated:
				if (modes & BIND_NO_DUP) {
					// Reset binding table (note BUF_WORDS may have expanded):
					for (word = BLK_HEAD(BUF_WORDS); NOT_END(word); word++)
						binds[VAL_WORD_CANON(word)] = 0;
					RESET_TAIL(BUF_WORDS);  // allow reuse
					Trap1(RE_DUP_VARS, value);
				}
			}
			continue;
		}
		// Recurse into sub-blocks:
		if (ANY_EVAL_BLOCK(value) && (modes & BIND_DEEP))
			Collect_Words(VAL_BLK_DATA(value), modes);
		// In this mode (foreach native), do not allow non-words:
		//else if (modes & BIND_GET) Trap_Arg(value);
	}
	BLK_TERM(BUF_WORDS);
}
Пример #7
0
*/ static void Collect_Frame_Inner_Loop(REBINT *binds, REBVAL value[], REBCNT modes)
/*
**		The inner recursive loop used for Collect_Frame function below.
**
***********************************************************************/
{
	for (; NOT_END(value); value++) {
		if (ANY_WORD(value)) {
			if (!binds[VAL_WORD_CANON(value)]) {  // only once per word
				if (IS_SET_WORD(value) || modes & BIND_ALL) {
					REBVAL *word;
					binds[VAL_WORD_CANON(value)] = SERIES_TAIL(BUF_WORDS);
					EXPAND_SERIES_TAIL(BUF_WORDS, 1);
					word = BLK_LAST(BUF_WORDS);
					Val_Init_Word_Typed(
						word,
						VAL_TYPE(value),
						VAL_WORD_SYM(value),
						// Allow all datatypes but END or UNSET (initially):
						~((TYPESET(REB_END) | TYPESET(REB_UNSET)))
					);
				}
			} else {
				// If word duplicated:
				if (modes & BIND_NO_DUP) {
					// Reset binding table (note BUF_WORDS may have expanded):
					REBVAL *word;
					for (word = BLK_HEAD(BUF_WORDS); NOT_END(word); word++)
						binds[VAL_WORD_CANON(word)] = 0;
					RESET_TAIL(BUF_WORDS);  // allow reuse
					raise Error_1(RE_DUP_VARS, value);
				}
			}
			continue;
		}
		// Recurse into sub-blocks:
		if (ANY_EVAL_BLOCK(value) && (modes & BIND_DEEP))
			Collect_Frame_Inner_Loop(binds, VAL_BLK_DATA(value), modes);
		// In this mode (foreach native), do not allow non-words:
		//else if (modes & BIND_GET) raise Error_Invalid_Arg(value);
	}
	BLK_TERM(BUF_WORDS);
}
Пример #8
0
*/  REBSER *Merge_Frames(REBSER *parent, REBSER *child)
/*
**      Create a frame from two frames. Merge common fields.
**      Values from the second frame take precedence. No rebinding.
**
***********************************************************************/
{
	REBSER *wrds;
	REBSER *frame;
	REBVAL *words;
	REBVAL *value;
	REBCNT n;

	// Merge parent and child words. This trick works because the
	// word list is itself a valid block.
	wrds = Collect_Frame(BIND_ALL, parent, BLK_SKIP(FRM_WORD_SERIES(child),1));

	// Allocate frame (now that we know the correct size):
	frame = Make_Block(SERIES_TAIL(wrds));  // GC!!!
	value = Append_Value(frame);
	VAL_SET(value, REB_FRAME);
	VAL_FRM_WORDS(value) = wrds;
	VAL_FRM_SPEC(value) = 0;

	// Copy parent values:
	COPY_VALUES(FRM_VALUES(parent)+1, FRM_VALUES(frame)+1, SERIES_TAIL(parent)-1);

	// Copy new words and values:
	words = FRM_WORDS(child)+1;
	value = FRM_VALUES(child)+1;
	for (; NOT_END(words); words++, value++) {
		n = Find_Word_Index(frame, VAL_BIND_SYM(words), FALSE);
		if (n) BLK_HEAD(frame)[n] = *value;
	}

	// Terminate the new frame:
	SERIES_TAIL(frame) = SERIES_TAIL(wrds);
	BLK_TERM(frame);

	return frame;
}
Пример #9
0
*/	void Modify_Blockx(REBCNT action, REBVAL *block, REBVAL *arg)
/*
**		Actions: INSERT, APPEND, CHANGE
**
**		block [block!] {Series at point to insert}
**		value [any-type!] {The value to insert}
**		/part {Limits to a given length or position.}
**		length [number! series! pair!]
**		/only {Inserts a series as a series.}
**		/dup {Duplicates the insert a specified number of times.}
**		count [number! pair!]
**
**	Add:
**		Handle insert [] () case
**		What does insert () [] do?
**		/deep option for cloning subcontents?
**
***********************************************************************/
{
	REBSER *series = VAL_SERIES(block);
	REBCNT index = VAL_INDEX(block);
	REBCNT tail  = VAL_TAIL(block);
	REBFLG only  = DS_REF(AN_ONLY);
	REBINT rlen;  // length to be removed
	REBINT ilen  = 1;  // length to be inserted
	REBINT cnt   = 1;  // DUP count
	REBINT size;
	REBFLG is_blk = FALSE; // arg is a block not a value

	// Length of target (may modify index): (arg can be anything)
	rlen = Partial1((action == A_CHANGE) ? block : arg, DS_ARG(AN_LENGTH));

	index = VAL_INDEX(block);
	if (action == A_APPEND || index > tail) index = tail;

	// Check /PART, compute LEN:
	if (!only && ANY_BLOCK(arg)) {
		is_blk = TRUE; // arg is a block
		// Are we modifying ourselves? If so, copy arg block first:
		if (series == VAL_SERIES(arg))  {
			VAL_SERIES(arg) = Copy_Block(VAL_SERIES(arg), VAL_INDEX(arg));
			VAL_INDEX(arg) = 0;
		}
		// Length of insertion:
		ilen = (action != A_CHANGE && DS_REF(AN_PART)) ? rlen : VAL_LEN(arg);
	}

	// Get /DUP count:
	if (DS_REF(AN_DUP)) {
		cnt = Int32(DS_ARG(AN_COUNT));
		if (cnt <= 0) return; // no changes
	}

	// Total to insert:
	size = cnt * ilen;

	if (action != A_CHANGE) {
		// Always expand series for INSERT and APPEND actions:
		Expand_Series(series, index, size);
	} else {
		if (size > rlen) 
			Expand_Series(series, index, size-rlen);
		else if (size < rlen && DS_REF(AN_PART))
			Remove_Series(series, index, rlen-size);
		else if (size + index > tail) {
			EXPAND_SERIES_TAIL(series, size - (tail - index));
		}
	}

	if (is_blk) arg = VAL_BLK_DATA(arg);

	// For dup count:
	VAL_INDEX(block) = (action == A_APPEND) ? 0 : size + index;

	index *= SERIES_WIDE(series); // loop invariant
	ilen *= SERIES_WIDE(series);   // loop invariant
	for (; cnt > 0; cnt--) {
		memcpy(series->data + index, (REBYTE *)arg, ilen);
		index += ilen;
	}
	BLK_TERM(series);
}
Пример #10
0
static void Append_Obj(REBSER *obj, REBVAL *arg)
{
	REBCNT i, len;
	REBVAL *word, *val;
	REBINT *binds; // for binding table

	// Can be a word:
	if (ANY_WORD(arg)) {
		if (!Find_Word_Index(obj, VAL_WORD_SYM(arg), TRUE)) {
			// bug fix, 'self is protected only in selfish frames
			if ((VAL_WORD_CANON(arg) == SYM_SELF) && !IS_SELFLESS(obj))
				Trap0(RE_SELF_PROTECTED);
			Expand_Frame(obj, 1, 1); // copy word table also
			Append_Frame(obj, 0, VAL_WORD_SYM(arg));
			// val is UNSET
		}
		return;
	}

	if (!IS_BLOCK(arg)) Trap_Arg(arg);

	// Process word/value argument block:
	arg = VAL_BLK_DATA(arg);

	// Use binding table
	binds = WORDS_HEAD(Bind_Table);
	// Handle selfless
	Collect_Start(IS_SELFLESS(obj) ? BIND_NO_SELF | BIND_ALL : BIND_ALL);
	// Setup binding table with obj words:
	Collect_Object(obj);

	// Examine word/value argument block
	for (word = arg; NOT_END(word); word += 2) {

		if (!IS_WORD(word) && !IS_SET_WORD(word)) {
			// release binding table
			BLK_TERM(BUF_WORDS);
			Collect_End(obj);
			Trap_Arg(word);
		}

		if (NZ(i = binds[VAL_WORD_CANON(word)])) {
			// bug fix, 'self is protected only in selfish frames:
			if ((VAL_WORD_CANON(word) == SYM_SELF) && !IS_SELFLESS(obj)) {
				// release binding table
				BLK_TERM(BUF_WORDS);
				Collect_End(obj);
				Trap0(RE_SELF_PROTECTED);
			}
		} else {
			// collect the word
			binds[VAL_WORD_CANON(word)] = SERIES_TAIL(BUF_WORDS);
			EXPAND_SERIES_TAIL(BUF_WORDS, 1);
			val = BLK_LAST(BUF_WORDS);
			*val = *word;
		}
		if (IS_END(word + 1)) break; // fix bug#708
	}

	BLK_TERM(BUF_WORDS);

	// Append new words to obj
	len = SERIES_TAIL(obj);
	Expand_Frame(obj, SERIES_TAIL(BUF_WORDS) - len, 1);
	for (word = BLK_SKIP(BUF_WORDS, len); NOT_END(word); word++)
		Append_Frame(obj, 0, VAL_WORD_SYM(word));

	// Set new values to obj words
	for (word = arg; NOT_END(word); word += 2) {

		i = binds[VAL_WORD_CANON(word)];
		val = FRM_VALUE(obj, i);
		if (GET_FLAGS(VAL_OPTS(FRM_WORD(obj, i)), OPTS_HIDE, OPTS_LOCK)) { 
			// release binding table
			Collect_End(obj);
			if (VAL_PROTECTED(FRM_WORD(obj, i)))
				Trap1(RE_LOCKED_WORD, FRM_WORD(obj, i));
			Trap0(RE_HIDDEN);
		}

		if (IS_END(word + 1)) SET_NONE(val);
		else *val = word[1];

		if (IS_END(word + 1)) break; // fix bug#708
	}

	// release binding table
	Collect_End(obj);
}
Пример #11
0
*/	REBCNT Modify_Block(REBCNT action, REBSER *dst_ser, REBCNT dst_idx, const REBVAL *src_val, REBCNT flags, REBINT dst_len, REBINT dups)
/*
**		action: INSERT, APPEND, CHANGE
**
**		dst_ser:	target
**		dst_idx:	position
**		src_val:    source
**		flags:		AN_ONLY, AN_PART
**		dst_len:	length to remove
**		dups:		dup count
**
**		return: new dst_idx
**
***********************************************************************/
{
	REBCNT tail  = SERIES_TAIL(dst_ser);
	REBINT ilen  = 1;	// length to be inserted
	REBINT size;		// total to insert

	if (dups < 0) return (action == A_APPEND) ? 0 : dst_idx;
	if (action == A_APPEND || dst_idx > tail) dst_idx = tail;

	// Check /PART, compute LEN:
	if (!GET_FLAG(flags, AN_ONLY) && ANY_BLOCK(src_val)) {
		// Adjust length of insertion if changing /PART:
		if (action != A_CHANGE && GET_FLAG(flags, AN_PART))
			ilen = dst_len;
		else
			ilen = VAL_LEN(src_val);

		// Are we modifying ourselves? If so, copy src_val block first:
		if (dst_ser == VAL_SERIES(src_val)) {
			REBSER *series = Copy_Block(
				VAL_SERIES(src_val), VAL_INDEX(src_val)
			);
			src_val = BLK_HEAD(series);
		}
		else
			src_val = VAL_BLK_DATA(src_val); // skips by VAL_INDEX values
	}

	// Total to insert:
	size = dups * ilen;

	if (action != A_CHANGE) {
		// Always expand dst_ser for INSERT and APPEND actions:
		Expand_Series(dst_ser, dst_idx, size);
	} else {
		if (size > dst_len)
			Expand_Series(dst_ser, dst_idx, size-dst_len);
		else if (size < dst_len && GET_FLAG(flags, AN_PART))
			Remove_Series(dst_ser, dst_idx, dst_len-size);
		else if (size + dst_idx > tail) {
			EXPAND_SERIES_TAIL(dst_ser, size - (tail - dst_idx));
		}
	}

	tail = (action == A_APPEND) ? 0 : size + dst_idx;

	dst_idx *= SERIES_WIDE(dst_ser); // loop invariant
	ilen  *= SERIES_WIDE(dst_ser); // loop invariant
	for (; dups > 0; dups--) {
		memcpy(dst_ser->data + dst_idx, src_val, ilen);
		dst_idx += ilen;
	}
	BLK_TERM(dst_ser);

	return tail;
}