示例#1
0
文件: n-loop.c 项目: mbk/ren-c
*/	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 { Trap_Arg(start); DEAD_END_VOID; }

	if (IS_INTEGER(end)) e = cast(REBDEC, VAL_INT64(end));
	else if (IS_DECIMAL(end) || IS_PERCENT(end)) e = VAL_DECIMAL(end);
	else { Trap_Arg(end); DEAD_END_VOID; }

	if (IS_INTEGER(incr)) i = cast(REBDEC, VAL_INT64(incr));
	else if (IS_DECIMAL(incr) || IS_PERCENT(incr)) i = VAL_DECIMAL(incr);
	else { Trap_Arg(incr); DEAD_END_VOID; }

	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(out, body, 0) && Check_Error(out) >= 0) break;

		if (!IS_DECIMAL(var)) Trap_Type(var);
		s = VAL_DECIMAL(var);
	}
}
示例#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
文件: t-pair.c 项目: Oldes/r3
*/	REBINT Min_Max_Pair(REBVAL *ds, REBFLG maxed)
/*
***********************************************************************/
{
	REBXYF aa;
	REBXYF bb;
	REBXYF *cc;
	REBVAL *a = D_ARG(1);
	REBVAL *b = D_ARG(2);
	REBVAL *c = D_RET;

	if (IS_PAIR(a)) aa = VAL_PAIR(a);
	else if (IS_INTEGER(a)) aa.x = aa.y = (REBD32)VAL_INT64(a);
	else Trap_Arg(a);

	if (IS_PAIR(b)) bb = VAL_PAIR(b);
	else if (IS_INTEGER(b)) bb.x = bb.y = (REBD32)VAL_INT64(b);
	else Trap_Arg(b);

	cc = &VAL_PAIR(c);
	if (maxed) {
		cc->x = MAX(aa.x, bb.x);
		cc->y = MAX(aa.y, bb.y);
	}
	else {
		cc->x = MIN(aa.x, bb.x);
		cc->y = MIN(aa.y, bb.y);
	}
	SET_TYPE(c, REB_PAIR);

	return R_RET;
}
示例#4
0
*/	static REBSER *Init_Loop(REBVAL *spec, REBVAL *body_blk, REBSER **fram)
/*
**		Initialize standard for loops (copy block, make frame, bind).
**		Spec: WORD or [WORD ...]
**
***********************************************************************/
{
	REBSER *frame;
	REBINT len;
	REBVAL *word;
	REBVAL *vals;
	REBSER *body;

	// For :WORD format, get the var's value:
	if (IS_GET_WORD(spec)) spec = Get_Var(spec);

	// Hand-make a FRAME (done for for speed):
	len = IS_BLOCK(spec) ? VAL_LEN(spec) : 1;
	if (len == 0) Trap_Arg(spec);
	frame = Make_Frame(len);
	SET_SELFLESS(frame);
	SERIES_TAIL(frame) = len+1;
	SERIES_TAIL(FRM_WORD_SERIES(frame)) = len+1;

	// Setup for loop:
	word = FRM_WORD(frame, 1); // skip SELF
	vals = BLK_SKIP(frame, 1);
	if (IS_BLOCK(spec)) spec = VAL_BLK_DATA(spec);

	// Optimally create the FOREACH frame:
	while (len-- > 0) {
		if (!IS_WORD(spec) && !IS_SET_WORD(spec)) {
			// Prevent inconsistent GC state:
			Free_Series(FRM_WORD_SERIES(frame));
			Free_Series(frame);
			Trap_Arg(spec);
		}
		VAL_SET(word, VAL_TYPE(spec));
		VAL_BIND_SYM(word) = VAL_WORD_SYM(spec);
		VAL_BIND_TYPESET(word) = ALL_64;
		word++;
		SET_NONE(vals);
		vals++;
		spec++;
	}
	SET_END(word);
	SET_END(vals);

	body = Clone_Block_Value(body_blk);
	Bind_Block(frame, BLK_HEAD(body), BIND_DEEP);

	*fram = frame;

	return body;
}
示例#5
0
文件: f-stubs.c 项目: 51weekend/r3
*/	REBINT Get_Num_Arg(REBVAL *val)
/*
**		Get the amount to skip or pick.
**		Allow multiple types. Throw error if not valid.
**		Note that the result is one-based.
**
***********************************************************************/
{
	REBINT n;

	if (IS_INTEGER(val)) {
		if (VAL_INT64(val) > (i64)MAX_I32 || VAL_INT64(val) < (i64)MIN_I32)
			Trap_Range(val);
		n = VAL_INT32(val);
	}
	else if (IS_DECIMAL(val) || IS_PERCENT(val)) {
		if (VAL_DECIMAL(val) > MAX_I32 || VAL_DECIMAL(val) < MIN_I32)
			Trap_Range(val);
		n = (REBINT)VAL_DECIMAL(val);
	}
	else if (IS_LOGIC(val)) n = (VAL_LOGIC(val) ? 1 : 2);
	else Trap_Arg(val);

	return n;
}
示例#6
0
*/	static void Sort_String(REBVAL *string, REBFLG ccase, REBVAL *skipv, REBVAL *compv, REBVAL *part, REBFLG all, REBFLG rev)
/*
***********************************************************************/
{
	REBCNT len;
	REBCNT skip = 1;
	REBCNT size = 1;
	int (*sfunc)(const void *v1, const void *v2);

	// Determine length of sort:
	len = Partial(string, 0, part, 0);
	if (len <= 1) return;

	// Skip factor:
	if (!IS_NONE(skipv)) {
		skip = Get_Num_Arg(skipv);
		if (skip <= 0 || len % skip != 0 || skip > len)
			Trap_Arg(skipv);
	}

	// Use fast quicksort library function:
	if (skip > 1) len /= skip, size *= skip;
	sfunc = rev ? Compare_Chr_Rev : Compare_Chr;

	//!!uni - needs to compare wide chars too
	qsort((void *)VAL_DATA(string), len, size * SERIES_WIDE(VAL_SERIES(string)), sfunc);
}
示例#7
0
文件: f-stubs.c 项目: 51weekend/r3
*/	REBDEC Dec64(REBVAL *val)
/*
***********************************************************************/
{
	if (IS_DECIMAL(val) || IS_PERCENT(val)) return VAL_DECIMAL(val);
	if (IS_INTEGER(val)) return (REBDEC)VAL_INT64(val);
	if (IS_MONEY(val)) return deci_to_decimal(VAL_DECI(val));
	Trap_Arg(val);
	return 0;
}
示例#8
0
文件: f-stubs.c 项目: 51weekend/r3
*/	REBI64 Int64(REBVAL *val)
/*
***********************************************************************/
{
	if (IS_INTEGER(val)) return VAL_INT64(val);
	if (IS_DECIMAL(val) || IS_PERCENT(val)) return (REBI64)VAL_DECIMAL(val);
	if (IS_MONEY(val)) return deci_to_int(VAL_DECI(val));
	Trap_Arg(val);
	return 0;
}
示例#9
0
文件: f-stubs.c 项目: 51weekend/r3
*/	REBFLG Get_Logic_Arg(REBVAL *arg)
/*
***********************************************************************/
{
	if (IS_NONE(arg)) return 0;
	if (IS_INTEGER(arg)) return (VAL_INT64(arg) != 0);
	if (IS_LOGIC(arg)) return (VAL_LOGIC(arg) != 0);
	if (IS_DECIMAL(arg) || IS_PERCENT(arg)) return (VAL_DECIMAL(arg) != 0.0);
	Trap_Arg(arg);
	DEAD_END;
}
示例#10
0
*/	static REBOOL Is_Of_Type(REBVAL *value, REBVAL *types)
/*
**		Types can be: word or block. Each element must be either
**		a datatype or a typeset.
**
***********************************************************************/
{
	REBVAL *val;

	val = IS_WORD(types) ? Get_Var(types) : types;

	if (IS_DATATYPE(val)) {
		return (VAL_DATATYPE(val) == (REBINT)VAL_TYPE(value));
	}

	if (IS_TYPESET(val)) {
		return (TYPE_CHECK(val, VAL_TYPE(value)));
	}

	if (IS_BLOCK(val)) {
		for (types = VAL_BLK_DATA(val); NOT_END(types); types++) {
			val = IS_WORD(types) ? Get_Var(types) : types;
			if (IS_DATATYPE(val))
				if (VAL_DATATYPE(val) == (REBINT)VAL_TYPE(value)) return TRUE;
			else if (IS_TYPESET(val))
				if (TYPE_CHECK(val, VAL_TYPE(value))) return TRUE;
			else
				Trap1(RE_INVALID_TYPE, Of_Type(val));
		}
		return FALSE;
	}

	Trap_Arg(types);

	return 0; // for compiler
}
示例#11
0
文件: t-gob.c 项目: Oldes/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 (i >= 0 && (REBINT)index > i) index--;
			}
		} else {
			Trap_Arg(val);
		}
	}
	arg = sarg;

	// Create or expand the pane series:
	if (!GOB_PANE(gob)) {
		GOB_PANE(gob) = Make_Series(count + 1, 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);
		}
	}
}
示例#12
0
文件: t-block.c 项目: 51weekend/r3
static void No_Nones(REBVAL *arg) {
	arg = VAL_BLK_DATA(arg);
	for (; NOT_END(arg); arg++) {
		if (IS_NONE(arg)) Trap_Arg(arg);
	}
}
示例#13
0
文件: t-object.c 项目: Oldes/r3
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);
}
示例#14
0
*/	static int Event_Actor(REBVAL *ds, REBSER *port, REBCNT action)
/*
***********************************************************************/
{
	REBVAL *spec;
	REBVAL *state;
	REBCNT result;
	REBVAL *arg;
	REBVAL save_port;

	Validate_Port(port, action);

	arg = D_ARG(2);
	*D_RET = *D_ARG(1);

	// Validate and fetch relevant PORT fields:
	state = BLK_SKIP(port, STD_PORT_STATE);
	spec  = BLK_SKIP(port, STD_PORT_SPEC);
	if (!IS_OBJECT(spec)) Trap1(RE_INVALID_SPEC, spec);

	// Get or setup internal state data:
	if (!IS_BLOCK(state)) Set_Block(state, Make_Block(127));

	switch (action) {

	case A_UPDATE:
		return R_NONE;

	// Normal block actions done on events:
	case A_POKE:
		if (!IS_EVENT(D_ARG(3))) Trap_Arg(D_ARG(3));
		goto act_blk;
	case A_INSERT:
	case A_APPEND:
	//case A_PATH:		// not allowed: port/foo is port object field access
	//case A_PATH_SET:	// not allowed: above
		if (!IS_EVENT(arg)) Trap_Arg(arg);
	case A_PICK:
act_blk:
		save_port = *D_ARG(1); // save for return
		*D_ARG(1) = *state;
		result = T_Block(ds, action);
		SET_FLAG(Eval_Signals, SIG_EVENT_PORT);
		if (action == A_INSERT || action == A_APPEND || action == A_REMOVE) {
			*D_RET = save_port;
			break;
		}
		return result; // return condition

	case A_CLEAR:
		VAL_TAIL(state) = 0;
		VAL_BLK_TERM(state);
		CLR_FLAG(Eval_Signals, SIG_EVENT_PORT);
		break;

	case A_LENGTHQ:
		SET_INTEGER(D_RET, VAL_TAIL(state));
		break;

	case A_OPEN:
		if (!req) { //!!!
			req = OS_MAKE_DEVREQ(RDI_EVENT);
			SET_OPEN(req);
			OS_DO_DEVICE(req, RDC_CONNECT);		// stays queued
		}
		break;

	default:
		Trap_Action(REB_PORT, action);
	}

	return R_RET;
}
示例#15
0
文件: c-error.c 项目: 51weekend/r3
*/	void Trap_Reflect(REBCNT type, REBVAL *arg)
/*
***********************************************************************/
{
	Trap_Arg(arg);
}
示例#16
0
文件: c-error.c 项目: 51weekend/r3
*/	void Make_Error_Object(REBVAL *arg, REBVAL *value)
/*
**		Creates an error object from arg and puts it in value.
**		The arg can be a string or an object body block.
**		This function is called by MAKE ERROR!.
**
***********************************************************************/
{
	REBSER *err;		// Error object
	ERROR_OBJ *error;	// Error object values
	REBINT code = 0;

	// Create a new error object from another object, including any non-standard fields:
	if (IS_ERROR(arg) || IS_OBJECT(arg)) {
		err = Merge_Frames(VAL_OBJ_FRAME(ROOT_ERROBJ),
			IS_ERROR(arg) ? VAL_OBJ_FRAME(arg) : VAL_ERR_OBJECT(arg));
		error = ERR_VALUES(err);
//		if (!IS_INTEGER(&error->code)) {
			if (!Find_Error_Info(error, &code)) code = RE_INVALID_ERROR;
			SET_INTEGER(&error->code, code);
//		}
		SET_ERROR(value, VAL_INT32(&error->code), err);
		return;
	}

	// Make a copy of the error object template:
	err = CLONE_OBJECT(VAL_OBJ_FRAME(ROOT_ERROBJ));
	error = ERR_VALUES(err);
	SET_NONE(&error->id);
	SET_ERROR(value, 0, err);

	// If block arg, evaluate object values (checking done later):
	// If user set error code, use it to setup type and id fields.
	if (IS_BLOCK(arg)) {
		DISABLE_GC;
		Do_Bind_Block(err, arg); // GC-OK (disabled)
		ENABLE_GC;
		if (IS_INTEGER(&error->code) && VAL_INT64(&error->code)) {
			Set_Error_Type(error);
		} else {
			if (Find_Error_Info(error, &code)) {
				SET_INTEGER(&error->code, code);
			}
		}
		// The error code is not valid:
		if (IS_NONE(&error->id)) {
			SET_INTEGER(&error->code, RE_INVALID_ERROR);
			Set_Error_Type(error);
		}
		if (VAL_INT64(&error->code) < 100 || VAL_INT64(&error->code) > 1000)
			Trap_Arg(arg);
	}

	// If string arg, setup other fields
	else if (IS_STRING(arg)) {
		SET_INTEGER(&error->code, RE_USER); // user error
		Set_String(&error->arg1, Copy_Series_Value(arg));
		Set_Error_Type(error);
	}

// No longer allowed:
//	else if (IS_INTEGER(arg)) {
//		error->code = *arg;
//		Set_Error_Type(error);
//	}
	else
		Trap_Arg(arg);

	if (!(VAL_ERR_NUM(value) = VAL_INT32(&error->code))) {
		Trap_Arg(arg);
	}
}
示例#17
0
文件: f-modify.c 项目: 51weekend/r3
*/	REBCNT Modify_String(REBCNT action, REBSER *dst_ser, REBCNT dst_idx, 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_PART
**		dst_len:	length to remove
**		dups:		dup count
**
**		return: new dst_idx
**
***********************************************************************/
{
	REBSER *src_ser = 0;
	REBCNT src_idx = 0;
	REBCNT src_len;
	REBCNT tail  = SERIES_TAIL(dst_ser);
	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;

	// If the src_val is not a string, then we need to create a string:
	if (GET_FLAG(flags, AN_SERIES)) { // used to indicate a BINARY series
		if (IS_INTEGER(src_val)) {
			src_ser = Append_Byte(0, Int8u(src_val)); // creates a binary
		}
		else if (IS_BLOCK(src_val)) {
			src_ser = Join_Binary(src_val); // NOTE: it's the shared FORM buffer!
		}
		else if (IS_CHAR(src_val)) {
			src_ser = Make_Binary(6); // (I hate unicode)
			src_ser->tail = Encode_UTF8_Char(BIN_HEAD(src_ser), VAL_CHAR(src_val));
		}
		else if (!ANY_BINSTR(src_val)) Trap_Arg(src_val);
	}
	else if (IS_CHAR(src_val)) {
		src_ser = Append_Byte(0, VAL_CHAR(src_val)); // unicode ok too
	}
	else if (IS_BLOCK(src_val)) {
		src_ser = Form_Tight_Block(src_val);
	}
	else if (!ANY_STR(src_val) || IS_TAG(src_val)) {
		src_ser = Copy_Form_Value(src_val, 0);
	}

	// Use either new src or the one that was passed:
	if (src_ser) {
		src_len = SERIES_TAIL(src_ser);
	}
	else {
		src_ser = VAL_SERIES(src_val);
		src_idx = VAL_INDEX(src_val);
		src_len = VAL_LEN(src_val);
	}

	// For INSERT or APPEND with /PART use the dst_len not src_len:
	if (action != A_CHANGE && GET_FLAG(flags, AN_PART)) src_len = dst_len;

	// If Source == Destination we need to prevent possible conflicts.
	// Clone the argument just to be safe.
	// (Note: It may be possible to optimize special cases like append !!)
	if (dst_ser == src_ser) {
		src_ser = Copy_Series_Part(src_ser, src_idx, src_len);
		src_idx = 0;
	}

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

	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));
		}
	}

	// For dup count:
	for (; dups > 0; dups--) {
		Insert_String(dst_ser, dst_idx, src_ser, src_idx, src_len, TRUE);
		dst_idx += src_len;
	}

	TERM_SERIES(dst_ser);

	return (action == A_APPEND) ? 0 : dst_idx;
}
示例#18
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;
}
示例#19
0
x*/	void Modify_StringX(REBCNT action, REBVAL *string, REBVAL *arg)
/*
**		Actions: INSERT, APPEND, CHANGE
**
**		string [string!] {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!]
**
***********************************************************************/
{
	REBSER *series = VAL_SERIES(string);
	REBCNT index = VAL_INDEX(string);
	REBCNT tail  = VAL_TAIL(string);
	REBINT rlen;  // length to be removed
	REBINT ilen  = 1;  // length to be inserted
	REBINT cnt   = 1;  // DUP count
	REBINT size;
	REBVAL *val;
	REBSER *arg_ser = 0; // argument series

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

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

	// If the arg is not a string, then we need to create a string:
	if (IS_BINARY(string)) {
		if (IS_INTEGER(arg)) {
			if (VAL_INT64(arg) > 255 || VAL_INT64(arg) < 0)
				Trap_Range(arg);
			arg_ser = Make_Binary(1);
			Append_Byte(arg_ser, VAL_CHAR(arg)); // check for size!!!
		}
		else if (!ANY_BINSTR(arg)) Trap_Arg(arg);
	}
	else if (IS_BLOCK(arg)) {
		// MOVE!
		REB_MOLD mo = {0};
		arg_ser = mo.series = Make_Unicode(VAL_BLK_LEN(arg) * 10); // GC!?
		for (val = VAL_BLK_DATA(arg); NOT_END(val); val++)
			Mold_Value(&mo, val, 0);
	}
	else if (IS_CHAR(arg)) {
		// Optimize this case !!!
		arg_ser = Make_Unicode(1);
		Append_Byte(arg_ser, VAL_CHAR(arg));
	}
	else if (!ANY_STR(arg) || IS_TAG(arg)) {
		arg_ser = Copy_Form_Value(arg, 0);
	}
	if (arg_ser) Set_String(arg, arg_ser);
	else arg_ser = VAL_SERIES(arg);

	// Length of insertion:
	ilen = (action != A_CHANGE && DS_REF(AN_PART)) ? rlen : VAL_LEN(arg);

	// If Source == Destination we need to prevent possible conflicts.
	// Clone the argument just to be safe.
	// (Note: It may be possible to optimize special cases like append !!)
	if (series == VAL_SERIES(arg)) {
		arg_ser = Copy_Series_Part(arg_ser, VAL_INDEX(arg), ilen);  // GC!?
	}

	// 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));
		}
	}

	// For dup count:
	for (; cnt > 0; cnt--) {
		Insert_String(series, index, arg_ser, VAL_INDEX(arg), ilen, TRUE);
		index += ilen;
	}

	TERM_SERIES(series);

	VAL_INDEX(string) = (action == A_APPEND) ? 0 : index;
}
示例#20
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;
}
示例#21
0
文件: t-object.c 项目: 51weekend/r3
static void Append_Obj(REBSER *obj, REBVAL *arg)
{
	REBCNT i;
	REBCNT len = 0;
	REBVAL *val;
	REBVAL *start = arg;

	// Can be a word:
	if (ANY_WORD(arg)) {
		if (!Find_Word_Index(obj, VAL_WORD_SYM(arg), TRUE)) {
			if (VAL_WORD_CANON(arg) == SYM_SELF) 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);

	// Verify word/value argument block:
	for (arg = VAL_BLK_DATA(arg); NOT_END(arg); arg += 2) {

		if (!IS_WORD(arg) && !IS_SET_WORD(arg)) Trap_Arg(arg);

		if (NZ(i = Find_Word_Index(obj, VAL_WORD_SYM(arg), TRUE))) {
			// Just change the value, do not append it.
			val = FRM_VALUE(obj, i);
			if (GET_FLAGS(VAL_OPTS(FRM_WORD(obj, i)), OPTS_HIDE, OPTS_LOCK)) { 
				// Back out... reset any prior flags:
				for (; arg != VAL_BLK_DATA(start); arg -= 2) VAL_CLR_OPT(arg, OPTS_TEMP);
				if (VAL_PROTECTED(FRM_WORD(obj, i))) Trap1(RE_LOCKED_WORD, FRM_WORD(obj, i));
				Trap0(RE_HIDDEN);
			}
			// Problem above: what about prior OPTS_FLAGS? Ok to leave them as is?
			if (IS_END(arg+1)) SET_NONE(val);
			else *val = arg[1];
			VAL_SET_OPT(arg, OPTS_TEMP);
		} else {
			if (VAL_WORD_CANON(arg) == SYM_SELF) Trap0(RE_SELF_PROTECTED);
			len++;
			// was: Trap1(RE_DUP_VARS, arg);
		}
	
		if (IS_END(arg+1)) break; // fix bug#708
	}

	// Append new values to end of frame (if necessary):
	if (len > 0) {
		Expand_Frame(obj, len, 1); // copy word table also
		for (arg = VAL_BLK_DATA(start); NOT_END(arg); arg += 2) {
			if (VAL_GET_OPT(arg, OPTS_TEMP)) VAL_CLR_OPT(arg, OPTS_TEMP);
			else {
				val = Append_Frame(obj, 0, VAL_WORD_SYM(arg));
				if (IS_END(arg+1)) {
					SET_NONE(val);
					break;
				}
				else *val = arg[1];
			}
		}
	}
}
示例#22
0
文件: t-block.c 项目: 51weekend/r3
*/	void Make_Block_Type(REBFLG make, REBVAL *value, REBVAL *arg)
/*
**		Value can be:
**			1. a datatype (e.g. BLOCK!)
**			2. a value (e.g. [...])
**
**		Arg can be:
**			1. integer (length of block)
**			2. block (copy it)
**			3. value (convert to a block)
**
***********************************************************************/
{
	REBCNT type;
	REBCNT len;
	REBSER *ser;

	// make block! ...
	if (IS_DATATYPE(value))
		type = VAL_DATATYPE(value);
	else  // make [...] ....
		type = VAL_TYPE(value);

	// make block! [1 2 3]
	if (ANY_BLOCK(arg)) {
		len = VAL_BLK_LEN(arg);
		if (len > 0 && type >= REB_PATH && type <= REB_LIT_PATH)
			No_Nones(arg);
		ser = Copy_Values(VAL_BLK_DATA(arg), len);
		goto done;
	}

	if (IS_STRING(arg)) {
		REBCNT index, len = 0;
		VAL_SERIES(arg) = Prep_Bin_Str(arg, &index, &len); // (keeps safe)
		ser = Scan_Source(VAL_BIN(arg), VAL_LEN(arg));
		goto done;
	}

	if (IS_BINARY(arg)) {
		ser = Scan_Source(VAL_BIN_DATA(arg), VAL_LEN(arg));
		goto done;
	}

	if (IS_MAP(arg)) {
		ser = Map_To_Block(VAL_SERIES(arg), 0);
		goto done;
	}

	if (ANY_OBJECT(arg)) {
		ser = Make_Object_Block(VAL_OBJ_FRAME(arg), 3);
		goto done;
	}

	if (IS_VECTOR(arg)) {
		ser = Make_Vector_Block(arg);
		goto done;
	}

//	if (make && IS_NONE(arg)) {
//		ser = Make_Block(0);
//		goto done;
//	}

	// to block! typset
	if (!make && IS_TYPESET(arg) && type == REB_BLOCK) {
		Set_Block(value, Typeset_To_Block(arg));
		return;
	}

	if (make) {
		// make block! 10
		if (IS_INTEGER(arg) || IS_DECIMAL(arg)) {
			len = Int32s(arg, 0);
			Set_Series(type, value, Make_Block(len));
			return;
		}
		Trap_Arg(arg);
	}

	ser = Copy_Values(arg, 1);

done:
	Set_Series(type, value, ser);
	return;
}