Пример #1
0
*/	void Do_Function(REBVAL *func)
/*
***********************************************************************/
{
	REBVAL *result;
	REBVAL *ds;

#if !defined(NDEBUG)
	const REBYTE *name = Get_Word_Name(DSF_LABEL(DSF));
#endif

	Eval_Functions++;

	//Dump_Block(VAL_FUNC_BODY(func));
	result = Do_Blk(VAL_FUNC_BODY(func), 0);
	ds = DS_OUT;

	if (IS_ERROR(result) && IS_RETURN(result)) {
		// Value below is kept safe from GC because no-allocation is
		// done between point of SET_THROW and here.
		if (VAL_ERR_VALUE(result))
			*ds = *VAL_ERR_VALUE(result);
		else
			SET_UNSET(ds);
	}
	else *ds = *result; // Set return value (atomic)
}
Пример #2
0
*/	static void Loop_Number(REBVAL *var, REBSER* body, REBVAL *start, REBVAL *end, REBVAL *incr)
/*
***********************************************************************/
{
	REBVAL *result;
	REBDEC s;
	REBDEC e;
	REBDEC i;

	if (IS_INTEGER(start)) s = (REBDEC)VAL_INT64(start);
	else if (IS_DECIMAL(start) || IS_PERCENT(start)) s = VAL_DECIMAL(start);
	else Trap_Arg(start);

	if (IS_INTEGER(end)) e = (REBDEC)VAL_INT64(end);
	else if (IS_DECIMAL(end) || IS_PERCENT(end)) e = VAL_DECIMAL(end);
	else Trap_Arg(end);

	if (IS_INTEGER(incr)) i = (REBDEC)VAL_INT64(incr);
	else if (IS_DECIMAL(incr) || IS_PERCENT(incr)) i = VAL_DECIMAL(incr);
	else Trap_Arg(incr);

	VAL_SET(var, REB_DECIMAL);

	for (; (i > 0.0) ? s <= e : s >= e; s += i) {
		VAL_DECIMAL(var) = s;
		result = Do_Blk(body, 0);
		if (THROWN(result) && Check_Error(result) >= 0) break;
		if (!IS_DECIMAL(var)) Trap_Type(var);
		s = VAL_DECIMAL(var);
	}
}
Пример #3
0
*/	void Do_Closure(REBVAL *func)
/*
**		Do a closure by cloning its body and binding it to
**		a new frame of words/values.
**
**		This could be made faster by pre-binding the body,
**		then using Rebind_Block to rebind the words in it.
**
***********************************************************************/
{
	REBSER *body;
	REBSER *frame;
	REBVAL *result;
	REBVAL *ds;

	Eval_Functions++;
	//DISABLE_GC;

	// Clone the body of the function to allow rebinding to it:
	body = Clone_Block(VAL_FUNC_BODY(func));

	// Copy stack frame args as the closure object (one extra at head)
	frame = Copy_Values(BLK_SKIP(DS_Series, DS_ARG_BASE), SERIES_TAIL(VAL_FUNC_ARGS(func)));
	SET_FRAME(BLK_HEAD(frame), 0, VAL_FUNC_ARGS(func));

	// Rebind the body to the new context (deeply):
	//Rebind_Block(VAL_FUNC_ARGS(func), frame, body);
	Bind_Block(frame, BLK_HEAD(body), BIND_DEEP); // | BIND_NO_SELF);

	ds = DS_RETURN;
	SET_OBJECT(ds, body); // keep it GC safe
	result = Do_Blk(body, 0); // GC-OK - also, result returned on DS stack
	ds = DS_RETURN;

	if (IS_ERROR(result) && IS_RETURN(result)) {
		// Value below is kept safe from GC because no-allocation is
		// done between point of SET_THROW and here.
		if (VAL_ERR_VALUE(result))
			*ds = *VAL_ERR_VALUE(result);
		else
			SET_UNSET(ds);
	}
	else *ds = *result; // Set return value (atomic)
}
Пример #4
0
*/	static void Loop_Integer(REBVAL *var, REBSER* body, REBI64 start, REBI64 end, REBI64 incr)
/*
***********************************************************************/
{
	REBVAL *result;

	VAL_SET(var, REB_INTEGER);
	
	while ((incr > 0) ? start <= end : start >= end) {
		VAL_INT64(var) = start;
		result = Do_Blk(body, 0);
		if (THROWN(result) && Check_Error(result) >= 0) break;
		if (!IS_INTEGER(var)) Trap_Type(var);
		start = VAL_INT64(var);
		
		if (REB_I64_ADD_OF(start, incr, &start)) {
			Trap0(RE_OVERFLOW);
		}
	}
}
Пример #5
0
*/	static void Loop_Series(REBVAL *var, REBSER* body, REBVAL *start, REBINT ei, REBINT ii)
/*
***********************************************************************/
{
	REBVAL *result;
	REBINT si = VAL_INDEX(start);
	REBCNT type = VAL_TYPE(start);

	*var = *start;
	
	if (ei >= (REBINT)VAL_TAIL(start)) ei = (REBINT)VAL_TAIL(start);
	if (ei < 0) ei = 0;

	for (; (ii > 0) ? si <= ei : si >= ei; si += ii) {
		VAL_INDEX(var) = si;
		result = Do_Blk(body, 0);
		if (THROWN(result) && Check_Error(result) >= 0) break;
		if (VAL_TYPE(var) != type) Trap1(RE_INVALID_TYPE, var);
		si = VAL_INDEX(var);
	}
}
Пример #6
0
*/	void Do_Commands(REBSER *cmds, void *context)
/*
**		Evaluate a block of commands as efficiently as possible.
**		The arguments to each command must already be reduced or
**		use only variable lookup.
**
**		Returns the last evaluated value, if provided.
**
***********************************************************************/
{
	REBVAL *blk;
	REBCNT index = 0;
	REBVAL *set_word = 0;
	REBVAL *cmd_word;
	REBSER *words;
	REBVAL *args;
	REBVAL *val;
	REBVAL *func;
	RXIFRM frm;	// args stored here
	REBCNT n;
	REBEXT *ext;
	REBCEC *ctx;

	if ((ctx = context)) ctx->block = cmds;
	blk = BLK_HEAD(cmds);

	while (NOT_END(blk)) {

		// var: command result
		if IS_SET_WORD(blk) {
			set_word = blk++;
			index++;
		};

		// get command function
		if (IS_WORD(cmd_word = blk)) {
			// Optimized var fetch:
			n = VAL_WORD_INDEX(blk);
			if (n > 0) func = FRM_VALUES(VAL_WORD_FRAME(blk)) + n;
			else func = Get_Var(blk); // fallback
		} else func = blk;

		if (!IS_COMMAND(func)) Trap2(RE_EXPECT_VAL, Get_Type_Word(REB_COMMAND), blk);

		// Advance to next value
		blk++;
		if (ctx) ctx->index = index; // position of function
		index++;

		// get command arguments and body
		words = VAL_FUNC_WORDS(func);
		RXA_COUNT(&frm) = SERIES_TAIL(VAL_FUNC_ARGS(func))-1; // not self

		// collect each argument (arg list already validated on MAKE)
		n = 0;
		for (args = BLK_SKIP(words, 1); NOT_END(args); args++) {

			//Debug_Type(args);
			val = blk++;
			index++;
			if (IS_END(val)) Trap2(RE_NO_ARG, cmd_word, args);
			//Debug_Type(val);

			// actual arg is a word, lookup?
			if (VAL_TYPE(val) >= REB_WORD) {
				if (IS_WORD(val)) {
					if (IS_WORD(args)) val = Get_Var(val);
				}
				else if (IS_PATH(val)) {
					if (IS_WORD(args)) val = Get_Any_Var(val); // volatile value!
				}
				else if (IS_PAREN(val)) {
					val = Do_Blk(VAL_SERIES(val), 0); // volatile value!
				}
				// all others fall through
			}

			// check datatype
			if (!TYPE_CHECK(args, VAL_TYPE(val)))
				Trap3(RE_EXPECT_ARG, cmd_word, args, Of_Type(val));

			// put arg into command frame
			n++;
			RXA_TYPE(&frm, n) = Reb_To_RXT[VAL_TYPE(val)];
			frm.args[n] = Value_To_RXI(val);
		}

		// Call the command (also supports different extension modules):
		func  = BLK_HEAD(VAL_FUNC_BODY(func));
		n = (REBCNT)VAL_INT64(func + 1);
		ext = &Ext_List[VAL_I32(VAL_OBJ_VALUE(func, 1))]; // Handler
		n = ext->call(n, &frm, context);
		val = DS_RETURN;
		switch (n) {
		case RXR_VALUE:
			RXI_To_Value(val, frm.args[1], RXA_TYPE(&frm, 1));
			break;
		case RXR_BLOCK:
			RXI_To_Block(&frm, val);
			break;
		case RXR_UNSET:
			SET_UNSET(val);
			break;
		case RXR_NONE:
			SET_NONE(val);
			break;
		case RXR_TRUE:
			SET_TRUE(val);
			break;
		case RXR_FALSE:
			SET_FALSE(val);
			break;
		case RXR_ERROR:
		default:
			SET_UNSET(val);
		}

		if (set_word) {
			Set_Var(set_word, val);
			set_word = 0;
		}
	}
}
Пример #7
0
*/	static int Loop_Each(REBVAL *ds, REBINT mode)
/*
**		Supports these natives (modes):
**			0: foreach
**			1: remove-each
**			2: map
**
***********************************************************************/
{
	REBSER *body;
	REBVAL *vars;
	REBVAL *words;
	REBSER *frame;
	REBVAL *value;
	REBSER *series;
	REBSER *out;	// output block (for MAP, mode = 2)

	REBINT index;	// !!!! should these be REBCNT?
	REBINT tail;
	REBINT windex;	// write
	REBINT rindex;	// read
	REBINT err;
	REBCNT i;
	REBCNT j;

	value = D_ARG(2); // series
	if (IS_NONE(value)) return R_NONE;

	body = Init_Loop(D_ARG(1), D_ARG(3), &frame); // vars, body
	SET_OBJECT(D_ARG(1), frame); // keep GC safe
	Set_Block(D_ARG(3), body);	 // keep GC safe

	SET_NONE(D_RET);
	SET_NONE(DS_NEXT);

	// If it's MAP, create result block:
	if (mode == 2) {
		out = Make_Block(VAL_LEN(value));
		Set_Block(D_RET, out);
	}

	// Get series info:
	if (ANY_OBJECT(value)) {
		series = VAL_OBJ_FRAME(value);
		out = FRM_WORD_SERIES(series); // words (the out local reused)
		index = 1;
		//if (frame->tail > 3) Trap_Arg(FRM_WORD(frame, 3));
	}
	else if (IS_MAP(value)) {
		series = VAL_SERIES(value);
		index = 0;
		//if (frame->tail > 3) Trap_Arg(FRM_WORD(frame, 3));
	}
	else {
		series = VAL_SERIES(value);
		index  = VAL_INDEX(value);
		if (index >= (REBINT)SERIES_TAIL(series)) {
			if (mode == 1) {
				SET_INTEGER(D_RET, 0);
			}
			return R_RET;
		}
	}

	windex = index;

	// Iterate over each value in the series block:
	while (index < (tail = SERIES_TAIL(series))) {

		rindex = index;  // remember starting spot
		j = 0;

		// Set the FOREACH loop variables from the series:
		for (i = 1; i < frame->tail; i++) {

			vars = FRM_VALUE(frame, i);
			words = FRM_WORD(frame, i);

			// var spec is WORD
			if (IS_WORD(words)) {

				if (index < tail) {

					if (ANY_BLOCK(value)) {
						*vars = *BLK_SKIP(series, index);
					}

					else if (ANY_OBJECT(value)) {
						if (!VAL_GET_OPT(BLK_SKIP(out, index), OPTS_HIDE)) {
							// Alternate between word and value parts of object:
							if (j == 0) {
								Set_Word(vars, VAL_WORD_SYM(BLK_SKIP(out, index)), series, index);
								if (NOT_END(vars+1)) index--; // reset index for the value part
							}
							else if (j == 1)
								*vars = *BLK_SKIP(series, index);
							else
								Trap_Arg(words);
							j++;
						}
						else {
							// Do not evaluate this iteration
							index++;
							goto skip_hidden;
						}
					}

					else if (IS_VECTOR(value)) {
						Set_Vector_Value(vars, series, index);
					}

					else if (IS_MAP(value)) {
						REBVAL *val = BLK_SKIP(series, index | 1);
						if (!IS_NONE(val)) {
							if (j == 0) {
								*vars = *BLK_SKIP(series, index & ~1);
								if (IS_END(vars+1)) index++; // only words
							}
							else if (j == 1)
								*vars = *BLK_SKIP(series, index);
							else
								Trap_Arg(words);
							j++;
						}
						else {
							index += 2;
							goto skip_hidden;
						}
					}

					else { // A string or binary
						if (IS_BINARY(value)) {
							SET_INTEGER(vars, (REBI64)(BIN_HEAD(series)[index]));
						}
						else if (IS_IMAGE(value)) {
							Set_Tuple_Pixel(BIN_SKIP(series, index), vars);
						}
						else {
							VAL_SET(vars, REB_CHAR);
							VAL_CHAR(vars) = GET_ANY_CHAR(series, index);
						}
					}
					index++;
				}
				else SET_NONE(vars);
			}

			// var spec is WORD:
			else if (IS_SET_WORD(words)) {
				if (ANY_OBJECT(value) || IS_MAP(value)) {
					*vars = *value;
				} else {
					VAL_SET(vars, REB_BLOCK);
					VAL_SERIES(vars) = series;
					VAL_INDEX(vars) = index;
				}
				//if (index < tail) index++; // do not increment block.
			}
			else Trap_Arg(words);
		}

		ds = Do_Blk(body, 0);

		if (THROWN(ds)) {
			if ((err = Check_Error(ds)) >= 0) break;
			// else CONTINUE:
			if (mode == 1) SET_FALSE(ds); // keep the value (for mode == 1)
		} else {
			err = 0; // prevent later test against uninitialized value
		}

		if (mode > 0) {
			//if (ANY_OBJECT(value)) Trap_Types(words, REB_BLOCK, VAL_TYPE(value)); //check not needed

			// If FALSE return, copy values to the write location:
			if (mode == 1) {  // remove-each
				if (IS_FALSE(ds)) {
					REBCNT wide = SERIES_WIDE(series);
					// memory areas may overlap, so use memmove and not memcpy!
					memmove(series->data + (windex * wide), series->data + (rindex * wide), (index - rindex) * wide);
					windex += index - rindex;
					// old: while (rindex < index) *BLK_SKIP(series, windex++) = *BLK_SKIP(series, rindex++);
				}
			}
			else
				if (!IS_UNSET(ds)) Append_Val(out, ds); // (mode == 2)
		}
skip_hidden: ;
	}

	// Finish up:
	if (mode == 1) {
		// Remove hole (updates tail):
		if (windex < index) Remove_Series(series, windex, index - windex);
		SET_INTEGER(DS_RETURN, index - windex);
		return R_RET;
	}

	// If MAP and not BREAK/RETURN:
	if (mode == 2 && err != 2) return R_RET;

	return R_TOS1;
}
Пример #8
0
*/	static int Loop_All(REBVAL *ds, REBINT mode)
/*
**		0: forall
**		1: forskip
**
***********************************************************************/
{
	REBVAL *var;
	REBSER *body;
	REBCNT bodi;
	REBSER *dat;
	REBINT idx;
	REBINT inc = 1;
	REBCNT type;

	var = Get_Var(D_ARG(1));
	if (IS_NONE(var)) return R_NONE;

	// Save the starting var value:
	*D_ARG(1) = *var;

	SET_NONE(D_RET);

	if (mode == 1) inc = Int32(D_ARG(2));

	type = VAL_TYPE(var);
	body = VAL_SERIES(D_ARG(mode+2));
	bodi = VAL_INDEX(D_ARG(mode+2));

	// Starting location when past end with negative skip:
	if (inc < 0 && VAL_INDEX(var) >= (REBINT)VAL_TAIL(var)) {
		VAL_INDEX(var) = (REBINT)VAL_TAIL(var) + inc;
	}

	// NOTE: This math only works for index in positive ranges!

	if (ANY_SERIES(var)) {
		while (TRUE) {
			dat = VAL_SERIES(var);
			idx = (REBINT)VAL_INDEX(var);
			if (idx < 0) break;
			if (idx >= (REBINT)SERIES_TAIL(dat)) {
				if (inc >= 0) break;
				idx = (REBINT)SERIES_TAIL(dat) + inc; // negative
				if (idx < 0) break;
				VAL_INDEX(var) = idx;
			}

			ds = Do_Blk(body, bodi); // (may move stack)

			if (THROWN(ds)) {	// Break, throw, continue, error.
				if (Check_Error(ds) >= 0) {
					*DS_RETURN = *DS_NEXT;
					break;
				}
			}
			*DS_RETURN = *ds;

			if (VAL_TYPE(var) != type) Trap_Arg(var);

			VAL_INDEX(var) += inc;
		}
	}
	else Trap_Arg(var);

	// !!!!! ???? allowed to write VAR????
	*var = *DS_ARG(1);

	return R_RET;
}