예제 #1
0
파일: c-port.c 프로젝트: kealist/ren-c
*/	void Sieve_Ports(REBSER *ports)
/*
**		Remove all ports not found in the WAKE list.
**		ports could be NULL, in which case the WAKE list is cleared.
**
***********************************************************************/
{
	REBVAL *port;
	REBVAL *waked;
	REBVAL *val;
	REBCNT n;

	port = Get_System(SYS_PORTS, PORTS_SYSTEM);
	if (!IS_PORT(port)) return;
	waked = VAL_OBJ_VALUE(port, STD_PORT_DATA);
	if (!IS_BLOCK(waked)) return;

	for (n = 0; ports && n < SERIES_TAIL(ports);) {
		val = BLK_SKIP(ports, n);
		if (IS_PORT(val)) {
			assert(VAL_TAIL(waked) != 0);
			if (VAL_TAIL(waked) == Find_Block_Simple(VAL_SERIES(waked), 0, val)) {//not found
				Remove_Series(ports, n, 1);
				continue;
			}
		}
		n++;
	}
	//clear waked list
	RESET_SERIES(VAL_SERIES(waked));
}
예제 #2
0
파일: s-mold.c 프로젝트: dailybarid/rebol
STOID Mold_File(REBVAL *value, REB_MOLD *mold)
{
	REBUNI *dp;
	REBCNT n;
	REBUNI c;
	REBCNT len = VAL_LEN(value);
	REBSER *ser = VAL_SERIES(value);

	// Compute extra space needed for hex encoded characters:
	for (n = VAL_INDEX(value); n < VAL_TAIL(value); n++) {
		c = GET_ANY_CHAR(ser, n);
		if (IS_FILE_ESC(c)) len += 2;
	}

	len++; // room for % at start

	dp = Prep_Uni_Series(mold, len);

	*dp++ = '%';

	for (n = VAL_INDEX(value); n < VAL_TAIL(value); n++) {
		c = GET_ANY_CHAR(ser, n);
		if (IS_FILE_ESC(c)) dp = Form_Hex_Esc_Uni(dp, c);  // c => %xx
		else *dp++ = c;
	}

	*dp = 0;
}
예제 #3
0
파일: n-loop.c 프로젝트: mbk/ren-c
*/	static void Loop_Series(REBVAL *out, REBVAL *var, REBSER* body, REBVAL *start, REBINT ei, REBINT ii)
/*
***********************************************************************/
{
	REBINT si = VAL_INDEX(start);
	REBCNT type = VAL_TYPE(start);

	*var = *start;

	if (ei >= cast(REBINT, VAL_TAIL(start)))
		ei = cast(REBINT, VAL_TAIL(start));

	if (ei < 0) ei = 0;

	SET_NONE(out); // Default result to NONE if the loop does not run

	for (; (ii > 0) ? si <= ei : si >= ei; si += ii) {
		VAL_INDEX(var) = si;

		if (!DO_BLOCK(out, body, 0) && Check_Error(out) >= 0) break;

		if (VAL_TYPE(var) != type) Trap1(RE_INVALID_TYPE, var);
		si = VAL_INDEX(var);
	}
}
예제 #4
0
파일: n-loop.c 프로젝트: kealist/ren-c
*/	static void Loop_Series(REBVAL *out, REBVAL *var, REBSER* body, REBVAL *start, REBINT ei, REBINT ii)
/*
***********************************************************************/
{
	REBINT si = VAL_INDEX(start);
	REBCNT type = VAL_TYPE(start);

	*var = *start;

	if (ei >= cast(REBINT, VAL_TAIL(start)))
		ei = cast(REBINT, VAL_TAIL(start));

	if (ei < 0) ei = 0;

	SET_NONE(out); // Default result to NONE if the loop does not run

	for (; (ii > 0) ? si <= ei : si >= ei; si += ii) {
		VAL_INDEX(var) = si;

		if (Do_Block_Throws(out, body, 0)) {
			if (Loop_Throw_Should_Return(out)) break;
		}

		if (VAL_TYPE(var) != type) raise Error_1(RE_INVALID_TYPE, var);
		si = VAL_INDEX(var);
	}
}
예제 #5
0
파일: f-stubs.c 프로젝트: 51weekend/r3
*/	REBCNT Val_Byte_Len(REBVAL *value)
/*
**		Get length of series in bytes.
**
***********************************************************************/
{
	if (VAL_INDEX(value) >= VAL_TAIL(value)) return 0;
	return (VAL_TAIL(value) - VAL_INDEX(value)) * SERIES_WIDE(VAL_SERIES(value));
}
예제 #6
0
파일: f-stubs.c 프로젝트: 51weekend/r3
*/	REBCNT Val_Series_Len(REBVAL *value)
/*
**		Get length of series, but avoid negative values.
**
***********************************************************************/
{
	if (VAL_INDEX(value) >= VAL_TAIL(value)) return 0;
	return VAL_TAIL(value) - VAL_INDEX(value);
}
예제 #7
0
파일: u-parse.c 프로젝트: Tectorum/rebol
*/	static REBCNT Set_Parse_Series(REBPARSE *parse, REBVAL *item)
/*
**		Change the series and return the new index.
**
***********************************************************************/
{
	parse->series = VAL_SERIES(item);
	parse->type = VAL_TYPE(item);
	if (IS_BINARY(item) || (parse->flags & PF_CASED)) parse->flags |= PF_CASE;
	else parse->flags &= ~PF_CASE;
	return (VAL_INDEX(item) > VAL_TAIL(item)) ? VAL_TAIL(item) : VAL_INDEX(item);
}
예제 #8
0
파일: c-port.c 프로젝트: kealist/ren-c
*/	REBINT Awake_System(REBSER *ports, REBINT only)
/*
**	Returns:
**		-1 for errors
**		 0 for nothing to do
**		 1 for wait is satisifed
**
***********************************************************************/
{
	REBVAL *port;
	REBVAL *state;
	REBVAL *waked;
	REBVAL *awake;
	REBVAL tmp;
	REBVAL ref_only;
	REBINT result;
	REBVAL out;

	// Get the system port object:
	port = Get_System(SYS_PORTS, PORTS_SYSTEM);
	if (!IS_PORT(port)) return -10; // verify it is a port object

	// Get wait queue block (the state field):
	state = VAL_OBJ_VALUE(port, STD_PORT_STATE);
	if (!IS_BLOCK(state)) return -10;
	//Debug_Num("S", VAL_TAIL(state));

	// Get waked queue block:
	waked = VAL_OBJ_VALUE(port, STD_PORT_DATA);
	if (!IS_BLOCK(waked)) return -10;

	// If there is nothing new to do, return now:
	if (VAL_TAIL(state) == 0 && VAL_TAIL(waked) == 0) return -1;

	//Debug_Num("A", VAL_TAIL(waked));
	// Get the system port AWAKE function:
	awake = VAL_OBJ_VALUE(port, STD_PORT_AWAKE);
	if (!ANY_FUNC(awake)) return -1;
	if (ports) Val_Init_Block(&tmp, ports);
	else SET_NONE(&tmp);

	if (only) SET_TRUE(&ref_only);
	else SET_NONE(&ref_only);
	// Call the system awake function:
	if (Apply_Func_Throws(&out, awake, port, &tmp, &ref_only, 0))
		raise Error_No_Catch_For_Throw(&out);

	// Awake function returns 1 for end of WAIT:
	result = (IS_LOGIC(&out) && VAL_LOGIC(&out)) ? 1 : 0;

	return result;
}
예제 #9
0
*/	REBFLG MT_String(REBVAL *out, REBVAL *data, REBCNT type)
/*
***********************************************************************/
{
	REBCNT i;

	if (!ANY_BINSTR(data)) return FALSE;
	*out = *data++;
	VAL_SET(out, type);
	i = IS_INTEGER(data) ? Int32(data) - 1 : 0;
	if (i > VAL_TAIL(out)) i = VAL_TAIL(out); // clip it
	VAL_INDEX(out) = i;
	return TRUE;
}
예제 #10
0
파일: t-block.c 프로젝트: 51weekend/r3
*/	REBINT PD_Block(REBPVS *pvs)
/*
***********************************************************************/
{
	REBINT n = 0;

	/* Issues!!!
		a/1.3
		a/not-found: 10 error or append?
		a/not-followed: 10 error or append?
	*/

	if (IS_INTEGER(pvs->select)) {
		n = Int32(pvs->select) + VAL_INDEX(pvs->value) - 1;
	}
	else if (IS_WORD(pvs->select)) {
		n = Find_Word(VAL_SERIES(pvs->value), VAL_INDEX(pvs->value), VAL_WORD_CANON(pvs->select));
		if (n != NOT_FOUND) n++;
	}
	else {
		// other values:
		n = Find_Block_Simple(VAL_SERIES(pvs->value), VAL_INDEX(pvs->value), pvs->select) + 1;
	}

	if (n < 0 || (REBCNT)n >= VAL_TAIL(pvs->value)) {
		if (pvs->setval) return PE_BAD_SELECT;
		return PE_NONE;
	}

	if (pvs->setval) TRAP_PROTECT(VAL_SERIES(pvs->value));
	pvs->value = VAL_BLK_SKIP(pvs->value, n);
	// if valset - check PROTECT on block
	//if (NOT_END(pvs->path+1)) Next_Path(pvs); return PE_OK;
	return PE_SET;
}
예제 #11
0
*/	REBVAL *Append_Event()
/*
**		Append an event to the end of the current event port queue.
**		Return a pointer to the event value.
**
**		Note: this function may be called from out of environment,
**		so do NOT extend the event queue here. If it does not have
**		space, return 0. (Should it overwrite or wrap???)
**
***********************************************************************/
{
	REBVAL *port;
	REBVAL *value;
	REBVAL *state;

	port = Get_System(SYS_PORTS, PORTS_SYSTEM);
	if (!IS_PORT(port)) return 0; // verify it is a port object

	// Get queue block:
	state = VAL_BLK_SKIP(port, STD_PORT_STATE);
	if (!IS_BLOCK(state)) return 0;

	// Append to tail if room:
	if (SERIES_FULL(VAL_SERIES(state))) Crash(RP_MAX_EVENTS);
	VAL_TAIL(state)++;
	value = VAL_BLK_TAIL(state);
	SET_END(value);
	value--;
	SET_NONE(value);

	//Dump_Series(VAL_SERIES(state), "state");
	//Print("Tail: %d %d", VAL_TAIL(state), nn++);

	return value;
}
예제 #12
0
파일: t-block.c 프로젝트: 51weekend/r3
*/	REBFLG MT_Block(REBVAL *out, REBVAL *data, REBCNT type)
/*
***********************************************************************/
{
	REBCNT i;

	if (!ANY_BLOCK(data)) return FALSE;
	if (type >= REB_PATH && type <= REB_LIT_PATH)
		if (!ANY_WORD(VAL_BLK(data))) return FALSE;

	*out = *data++;
	VAL_SET(out, type);
	i = IS_INTEGER(data) ? Int32(data) - 1 : 0;
	if (i > VAL_TAIL(out)) i = VAL_TAIL(out); // clip it
	VAL_INDEX(out) = i;
	return TRUE;
}
예제 #13
0
*/	REBINT PD_String(REBPVS *pvs)
/*
***********************************************************************/
{
	REBVAL *data = pvs->value;
	REBVAL *val = pvs->setval;
	REBINT n = 0;
	REBCNT i;
	REBINT c;
	REBSER *ser = VAL_SERIES(data);

	if (IS_INTEGER(pvs->select)) {
		n = Int32(pvs->select) + VAL_INDEX(data) - 1;
	}
	else return PE_BAD_SELECT;

	if (val == 0) {
		if (n < 0 || (REBCNT)n >= SERIES_TAIL(ser)) return PE_NONE;
		if (IS_BINARY(data)) {
			SET_INTEGER(pvs->store, *BIN_SKIP(ser, n));
		} else {
			SET_CHAR(pvs->store, GET_ANY_CHAR(ser, n));
		}
		return PE_USE;
	}

	if (n < 0 || (REBCNT)n >= SERIES_TAIL(ser)) return PE_BAD_RANGE;

	if (IS_CHAR(val)) {
		c = VAL_CHAR(val);
		if (c > MAX_CHAR) return PE_BAD_SET;
	}
	else if (IS_INTEGER(val)) {
		c = Int32(val);
		if (c > MAX_CHAR || c < 0) return PE_BAD_SET;
		if (IS_BINARY(data)) { // special case for binary
			if (c > 0xff) Trap_Range(val);
			BIN_HEAD(ser)[n] = (REBYTE)c;
			return PE_OK;
		}
	}
	else if (ANY_BINSTR(val)) {
		i = VAL_INDEX(val);
		if (i >= VAL_TAIL(val)) return PE_BAD_SET;
		c = GET_ANY_CHAR(VAL_SERIES(val), i);
	}
	else
		return PE_BAD_SELECT;

	TRAP_PROTECT(ser);

	if (BYTE_SIZE(ser) && c > 0xff) Widen_String(ser);
	SET_ANY_CHAR(ser, n, c);

	return PE_OK;
}
예제 #14
0
파일: t-block.c 프로젝트: 51weekend/r3
*/	REBVAL *Pick_Block(REBVAL *block, REBVAL *selector)
/*
***********************************************************************/
{
	REBINT n = 0;

	n = Get_Num_Arg(selector);
	n += VAL_INDEX(block) - 1;
	if (n < 0 || (REBCNT)n >= VAL_TAIL(block)) return 0;
	return VAL_BLK_SKIP(block, n);
}
예제 #15
0
파일: t-bitset.c 프로젝트: kealist/ren-c
*/	REBFLG Check_Bit_Str(REBSER *bset, REBVAL *val, REBFLG uncased)
/*
**		If uncased is TRUE, try to match either upper or lower case.
**
***********************************************************************/
{
	REBCNT n = VAL_INDEX(val);

	if (VAL_BYTE_SIZE(val)) {
		REBYTE *bp = VAL_BIN(val);
		for (; n < VAL_TAIL(val); n++)
			if (Check_Bit(bset, bp[n], uncased)) return TRUE;
	}
	else {
		REBUNI *up = VAL_UNI(val);
		for (; n < VAL_TAIL(val); n++)
			if (Check_Bit(bset, up[n], uncased)) return TRUE;
	}
	return FALSE;
}
예제 #16
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);
	}
}
예제 #17
0
파일: f-stubs.c 프로젝트: 51weekend/r3
*/	 REBINT Partial1(REBVAL *sval, REBVAL *lval)
/*
**		Process the /part (or /skip) and other length modifying
**		arguments.
**
***********************************************************************/
{
	REBI64 len;
	REBINT maxlen;
	REBINT is_ser = ANY_SERIES(sval);

	// If lval = NONE, use the current len of the target value:
	if (IS_NONE(lval)) {
		if (!is_ser) return 1;
		if (VAL_INDEX(sval) >= VAL_TAIL(sval)) return 0;
		return (VAL_TAIL(sval) - VAL_INDEX(sval));
	}
	if (IS_INTEGER(lval) || IS_DECIMAL(lval)) len = Int32(lval);
	else {
		if (is_ser && VAL_TYPE(sval) == VAL_TYPE(lval) && VAL_SERIES(sval) == VAL_SERIES(lval))
			len = (REBINT)VAL_INDEX(lval) - (REBINT)VAL_INDEX(sval);
		else
			Trap1(RE_INVALID_PART, lval);

	}

	if (is_ser) {
		// Restrict length to the size available:
		if (len >= 0) {
			maxlen = (REBINT)VAL_LEN(sval);
			if (len > maxlen) len = maxlen;
		} else {
			len = -len;
			if (len > (REBINT)VAL_INDEX(sval)) len = (REBINT)VAL_INDEX(sval);
			VAL_INDEX(sval) -= (REBCNT)len;
		}
	}

	return (REBINT)len;
}
예제 #18
0
파일: s-mold.c 프로젝트: draegtun/ren-c
static void Mold_Url(const REBVAL *value, REB_MOLD *mold)
{
	REBUNI *dp;
	REBCNT n;
	REBUNI c;
	REBCNT len = VAL_LEN(value);
	REBSER *ser = VAL_SERIES(value);

	// Compute extra space needed for hex encoded characters:
	for (n = VAL_INDEX(value); n < VAL_TAIL(value); n++) {
		c = GET_ANY_CHAR(ser, n);
		if (IS_URL_ESC(c)) len += 2;
	}

	dp = Prep_Uni_Series(mold, len);

	for (n = VAL_INDEX(value); n < VAL_TAIL(value); n++) {
		c = GET_ANY_CHAR(ser, n);
		if (IS_URL_ESC(c)) dp = Form_Hex_Esc_Uni(dp, c);  // c => %xx
		else *dp++ = c;
	}

	*dp = 0;
}
예제 #19
0
파일: s-mold.c 프로젝트: dailybarid/rebol
STOID Mold_Issue(REBVAL *value, REB_MOLD *mold)
{
	REBUNI *dp;
	REBCNT n;
	REBUNI c;
	REBSER *ser = VAL_SERIES(value);

	dp = Prep_Uni_Series(mold, VAL_LEN(value)+1); // '#' extra

	*dp++ = '#';

	for (n = VAL_INDEX(value); n < VAL_TAIL(value); n++) {
		c = GET_ANY_CHAR(ser, n);
		if (IS_LEX_DELIMIT(c)) c = '?';
		*dp++ = c;
	}

	*dp = 0;
}
예제 #20
0
xx*/	void Dump_Block_Raw(REBSER *series, int depth, int max_depth)
/*
***********************************************************************/
{
	REBVAL *val;
	REBCNT n;
	REBYTE *str;

	if (!IS_BLOCK_SERIES(series) || depth > max_depth) return;

	for (n = 0, val = BLK_HEAD(series); NOT_END(val); val++, n++) {
		Debug_Chars(' ', depth * 4);
		if (IS_BLOCK(val)) {
			Debug_Fmt("%3d: [%s] len: %d", n, Get_Type_Name(val), VAL_TAIL(val));
			Dump_Block_Raw(VAL_SERIES(val), depth + 1, max_depth);
		} else {
			str = "";
			if (ANY_WORD(val)) str = Get_Word_Name(val);
			Debug_Fmt("%3d: [%s] %s", n, Get_Type_Name(val), str);
		}
	}
	//if (depth == 2) Input_Str();
}
예제 #21
0
파일: s-mold.c 프로젝트: dailybarid/rebol
STOID Mold_Error(REBVAL *value, REB_MOLD *mold, REBFLG molded)
{
	ERROR_OBJ *err;
	REBVAL *msg;  // Error message block

	// Protect against recursion. !!!!

	if (molded) {
		if (VAL_OBJ_FRAME(value) && VAL_ERR_NUM(value) >= RE_NOTE && VAL_ERR_OBJECT(value))
			Mold_Object(value, mold);
		else {
			// Happens if throw or return is molded.
			// make error! 0-3
			Pre_Mold(value, mold);
			Append_Int(mold->series, VAL_ERR_NUM(value));
			End_Mold(mold);
		}
		return;
	}

	// If it is an unprocessed BREAK, THROW, CONTINUE, RETURN:
	if (VAL_ERR_NUM(value) < RE_NOTE || !VAL_ERR_OBJECT(value)) {
		VAL_ERR_OBJECT(value) = Make_Error(VAL_ERR_NUM(value), value, 0, 0); // spoofs field
	}
	err = VAL_ERR_VALUES(value);

	// Form: ** <type> Error:
	Emit(mold, "** WB", &err->type, RS_ERRS+0);

	// Append: error message ARG1, ARG2, etc.
	msg = Find_Error_Info(err, 0);
	if (msg) {
		if (!IS_BLOCK(msg)) Mold_Value(mold, msg, 0);
		else {
			//start = DSP + 1;
			//Reduce_In_Frame(VAL_ERR_OBJECT(value), VAL_BLK_DATA(msg));
			//SERIES_TAIL(DS_Series) = DSP + 1;
			//Form_Block_Series(DS_Series, start, mold, 0);
			Form_Block_Series(VAL_SERIES(msg), 0, mold, VAL_ERR_OBJECT(value));
		}
	} else
		Append_Boot_Str(mold->series, RS_ERRS+1);

	Append_Byte(mold->series, '\n');

	// Form: ** Where: function
	value = &err->where;
	if (VAL_TYPE(value) > REB_NONE) {
		Append_Boot_Str(mold->series, RS_ERRS+2);
		Mold_Value(mold, value, 0);
		Append_Byte(mold->series, '\n');
	}

	// Form: ** Near: location
	value = &err->nearest;
	if (VAL_TYPE(value) > REB_NONE) {
		Append_Boot_Str(mold->series, RS_ERRS+3);
		if (IS_STRING(value)) // special case: source file line number
			Append_String(mold->series, VAL_SERIES(value), 0, VAL_TAIL(value));
		else if (IS_BLOCK(value))
			Mold_Simple_Block(mold, VAL_BLK_DATA(value), 60);
		Append_Byte(mold->series, '\n');
	}
}
예제 #22
0
파일: s-mold.c 프로젝트: dailybarid/rebol
STOID Mold_Block(REBVAL *value, REB_MOLD *mold)
{
	REBYTE *sep;
	REBOOL all = GET_MOPT(mold, MOPT_MOLD_ALL);
	REBSER *series = mold->series;
	REBFLG over = FALSE;

	if (SERIES_WIDE(VAL_SERIES(value)) == 0)
		Crash(RP_BAD_WIDTH, sizeof(REBVAL), 0, VAL_TYPE(value));

	// Optimize when no index needed:
	if (VAL_INDEX(value) == 0 && !IS_MAP(value)) // && (VAL_TYPE(value) <= REB_LIT_PATH))
		all = FALSE;

	// If out of range, do not cause error to avoid error looping.
	if (VAL_INDEX(value) >= VAL_TAIL(value)) over = TRUE; // Force it into []

	if (all || (over && !IS_BLOCK(value) && !IS_PAREN(value))) {
		SET_FLAG(mold->opts, MOPT_MOLD_ALL);
		Pre_Mold(value, mold); // #[block! part
		//if (over) Append_Bytes(mold->series, "[]");
		//else
		Mold_Block_Series(mold, VAL_SERIES(value), 0, 0);
		Post_Mold(value, mold);
	}
	else
	{
		switch(VAL_TYPE(value)) {

		case REB_MAP:
			Pre_Mold(value, mold);
			sep = 0;

		case REB_BLOCK:
			if (GET_MOPT(mold, MOPT_ONLY)) {
				CLR_FLAG(mold->opts, MOPT_ONLY); // only top level
				sep = "\000\000";
			}
			else sep = 0;
			break;

		case REB_PAREN:
			sep = "()";
			break;

		case REB_GET_PATH:
			series = Append_Byte(series, ':');
			sep = "/";
			break;

		case REB_LIT_PATH:
			series = Append_Byte(series, '\'');
			/* fall through */
		case REB_PATH:
		case REB_SET_PATH:
			sep = "/";
			break;
		}

		if (over) Append_Bytes(mold->series, sep ? sep : (REBYTE*)("[]"));
		else Mold_Block_Series(mold, VAL_SERIES(value), VAL_INDEX(value), sep);

		if (VAL_TYPE(value) == REB_SET_PATH)
			Append_Byte(series, ':');
	}
}
예제 #23
0
파일: s-mold.c 프로젝트: dailybarid/rebol
STOID Mold_String_Series(REBVAL *value, REB_MOLD *mold)
{
	REBCNT len = VAL_LEN(value);
	REBSER *ser = VAL_SERIES(value);
	REBCNT idx = VAL_INDEX(value);
	REB_STRF sf = {0};
	REBYTE *bp;
	REBUNI *up;
	REBUNI *dp;
	REBOOL uni = !BYTE_SIZE(ser);
	REBCNT n;
	REBUNI c;

	// Empty string:
	if (idx >= VAL_TAIL(value)) {
		Append_Bytes(mold->series, "\"\"");  //Trap0(RE_PAST_END);
		return;
	}

	Sniff_String(ser, idx, &sf);
	if (!GET_MOPT(mold, MOPT_ANSI_ONLY)) sf.paren = 0;

	// Source can be 8 or 16 bits:
	if (uni) up = UNI_HEAD(ser);
	else bp = STR_HEAD(ser);

	// If it is a short quoted string, emit it as "string":
	if (len <= MAX_QUOTED_STR && sf.quote == 0 && sf.newline < 3) {

		dp = Prep_Uni_Series(mold, len + sf.newline + sf.escape + sf.paren + sf.chr1e + 2);

		*dp++ = '"';

		for (n = idx; n < VAL_TAIL(value); n++) {
			c = uni ? up[n] : (REBUNI)(bp[n]);
			dp = Emit_Uni_Char(dp, c, (REBOOL)GET_MOPT(mold, MOPT_ANSI_ONLY)); // parened
		}

		*dp++ = '"';
		*dp = 0;
		return;
	}

	// It is a braced string, emit it as {string}:
	if (!sf.malign) sf.brace_in = sf.brace_out = 0;

	dp = Prep_Uni_Series(mold, len + sf.brace_in + sf.brace_out + sf.escape + sf.paren + sf.chr1e + 2);

	*dp++ = '{';

	for (n = idx; n < VAL_TAIL(value); n++) {

		c = uni ? up[n] : (REBUNI)(bp[n]);
		switch (c) {
		case '{':
		case '}':
			if (sf.malign) {
				*dp++ = '^';
				*dp++ = c;
				break;
			}
		case '\n':
		case '"':
			*dp++ = c;
			break;
		default:
			dp = Emit_Uni_Char(dp, c, (REBOOL)GET_MOPT(mold, MOPT_ANSI_ONLY)); // parened
		}
	}

	*dp++ = '}';
	*dp = 0;
}
예제 #24
0
//
//  Make_Set_Operation_Series: C
// 
// Do set operations on a series.  Case-sensitive if `cased` is TRUE.
// `skip` is the record size.
//
static REBSER *Make_Set_Operation_Series(const REBVAL *val1, const REBVAL *val2, REBCNT flags, REBCNT cased, REBCNT skip)
{
    REBSER *buffer;     // buffer for building the return series
    REBCNT i;
    REBINT h = TRUE;
    REBFLG first_pass = TRUE; // are we in the first pass over the series?
    REBSER *out_ser;

    // This routine should only be called with SERIES! values
    assert(ANY_SERIES(val1));

    if (val2) {
        assert(ANY_SERIES(val2));

        if (ANY_ARRAY(val1)) {
            if (!ANY_ARRAY(val2))
                fail (Error_Unexpected_Type(VAL_TYPE(val1), VAL_TYPE(val2)));

            // As long as they're both arrays, we're willing to do:
            //
            //     >> union quote (a b c) 'b/d/e
            //     (a b c d e)
            //
            // The type of the result will match the first value.
        }
        else if (!IS_BINARY(val1)) {

            // We will similarly do any two ANY-STRING! types:
            //
            //      >> union <abc> "bde"
            //      <abcde>

            if (IS_BINARY(val2))
                fail (Error_Unexpected_Type(VAL_TYPE(val1), VAL_TYPE(val2)));
        }
        else {
            // Binaries only operate with other binaries

            if (!IS_BINARY(val2))
                fail (Error_Unexpected_Type(VAL_TYPE(val1), VAL_TYPE(val2)));
        }
    }

    // Calculate i as length of result block.
    i = VAL_LEN(val1);
    if (flags & SOP_FLAG_BOTH) i += VAL_LEN(val2);

    if (ANY_ARRAY(val1)) {
        REBSER *hser = 0;   // hash table for series
        REBSER *hret;       // hash table for return series

        buffer = BUF_EMIT;          // use preallocated shared block
        Resize_Series(buffer, i);
        hret = Make_Hash_Sequence(i);   // allocated

        // Optimization note: !!
        // This code could be optimized for small blocks by not hashing them
        // and extending Find_Key to do a FIND on the value itself w/o the hash.

        do {
            REBSER *ser = VAL_SERIES(val1); // val1 and val2 swapped 2nd pass!

            // Check what is in series1 but not in series2:
            if (flags & SOP_FLAG_CHECK)
                hser = Hash_Block(val2, cased);

            // Iterate over first series:
            i = VAL_INDEX(val1);
            for (; i < SERIES_TAIL(ser); i += skip) {
                REBVAL *item = BLK_SKIP(ser, i);
                if (flags & SOP_FLAG_CHECK) {
                    h = Find_Key(VAL_SERIES(val2), hser, item, skip, cased, 1);
                    h = (h >= 0);
                    if (flags & SOP_FLAG_INVERT) h = !h;
                }
                if (h) Find_Key(buffer, hret, item, skip, cased, 2);
            }

            if (flags & SOP_FLAG_CHECK)
                Free_Series(hser);

            if (!first_pass) break;
            first_pass = FALSE;

            // Iterate over second series?
            if ((i = ((flags & SOP_FLAG_BOTH) != 0))) {
                const REBVAL *temp = val1;
                val1 = val2;
                val2 = temp;
            }
        } while (i);

        if (hret)
            Free_Series(hret);

        out_ser = Copy_Array_Shallow(buffer);
        RESET_TAIL(buffer); // required - allow reuse
    }
    else {
        if (IS_BINARY(val1)) {
            // All binaries use "case-sensitive" comparison (e.g. each byte
            // is treated distinctly)
            cased = TRUE;
        }

        buffer = BUF_MOLD;
        Reset_Buffer(buffer, i);
        RESET_TAIL(buffer);

        do {
            REBSER *ser = VAL_SERIES(val1); // val1 and val2 swapped 2nd pass!
            REBUNI uc;

            // Iterate over first series:
            i = VAL_INDEX(val1);
            for (; i < SERIES_TAIL(ser); i += skip) {
                uc = GET_ANY_CHAR(ser, i);
                if (flags & SOP_FLAG_CHECK) {
                    h = (NOT_FOUND != Find_Str_Char(
                        VAL_SERIES(val2),
                        0,
                        VAL_INDEX(val2),
                        VAL_TAIL(val2),
                        skip,
                        uc,
                        cased ? AM_FIND_CASE : 0
                    ));

                    if (flags & SOP_FLAG_INVERT) h = !h;
                }

                if (!h) continue;

                if (
                    NOT_FOUND == Find_Str_Char(
                        buffer,
                        0,
                        0,
                        SERIES_TAIL(buffer),
                        skip,
                        uc,
                        cased ? AM_FIND_CASE : 0
                    )
                ) {
                    Append_String(buffer, ser, i, skip);
                }
            }

            if (!first_pass) break;
            first_pass = FALSE;

            // Iterate over second series?
            if ((i = ((flags & SOP_FLAG_BOTH) != 0))) {
                const REBVAL *temp = val1;
                val1 = val2;
                val2 = temp;
            }
        } while (i);

        out_ser = Copy_String(buffer, 0, -1);
    }

    return out_ser;
}
예제 #25
0
파일: t-bitset.c 프로젝트: kealist/ren-c
*/	REBINT Find_Max_Bit(REBVAL *val)
/*
**		Return integer number for the maximum bit number defined by
**		the value. Used to determine how much space to allocate.
**
***********************************************************************/
{
	REBINT maxi = 0;
	REBINT n;

	switch (VAL_TYPE(val)) {

	case REB_CHAR:
		maxi = VAL_CHAR(val)+1;
		break;

	case REB_INTEGER:
		maxi = Int32s(val, 0);
		break;

	case REB_STRING:
	case REB_FILE:
	case REB_EMAIL:
	case REB_URL:
	case REB_TAG:
//	case REB_ISSUE:
		n = VAL_INDEX(val);
		if (VAL_BYTE_SIZE(val)) {
			REBYTE *bp = VAL_BIN(val);
			for (; n < (REBINT)VAL_TAIL(val); n++)
				if (bp[n] > maxi) maxi = bp[n];
		}
		else {
			REBUNI *up = VAL_UNI(val);
			for (; n < (REBINT)VAL_TAIL(val); n++)
				if (up[n] > maxi) maxi = up[n];
		}
		maxi++;
		break;

	case REB_BINARY:
		maxi = VAL_LEN(val) * 8 - 1;
		if (maxi < 0) maxi = 0;
		break;

	case REB_BLOCK:
		for (val = VAL_BLK_DATA(val); NOT_END(val); val++) {
			n = Find_Max_Bit(val);
			if (n > maxi) maxi = n;
		}
		//maxi++;
		break;

	case REB_NONE:
		maxi = 0;
		break;

	default:
		return -1;
	}

	return maxi;
}
예제 #26
0
파일: n-sets.c 프로젝트: kealist/ren-c
*/	static REBINT Do_Set_Operation(struct Reb_Call *call_, REBCNT flags)
/*
**		Do set operations on a series.
**
***********************************************************************/
{
	REBVAL *val;
	REBVAL *val1;
	REBVAL *val2 = 0;
	REBSER *ser;
	REBSER *hser = 0;	// hash table for series
	REBSER *retser;		// return series
	REBSER *hret;		// hash table for return series
	REBCNT i;
	REBINT h = TRUE;
	REBCNT skip = 1;	// record size
	REBCNT cased = 0;	// case sensitive when TRUE

	SET_NONE(D_OUT);
	val1 = D_ARG(1);
	i = 2;

	// Check for second series argument:
	if (flags != SET_OP_UNIQUE) {
		val2 = D_ARG(i++);
		if (VAL_TYPE(val1) != VAL_TYPE(val2))
			raise Error_Unexpected_Type(VAL_TYPE(val1), VAL_TYPE(val2));
	}

	// Refinements /case and /skip N
	cased = D_REF(i++); // cased
	if (D_REF(i++)) skip = Int32s(D_ARG(i), 1);

	switch (VAL_TYPE(val1)) {

	case REB_BLOCK:
		i = VAL_LEN(val1);
		// Setup result block:
		if (GET_FLAG(flags, SOP_BOTH)) i += VAL_LEN(val2);
		retser = BUF_EMIT;			// use preallocated shared block
		Resize_Series(retser, i);
		hret = Make_Hash_Sequence(i);	// allocated

		// Optimization note: !!
		// This code could be optimized for small blocks by not hashing them
		// and extending Find_Key to do a FIND on the value itself w/o the hash.

		do {
			// Check what is in series1 but not in series2:
			if (GET_FLAG(flags, SOP_CHECK))
				hser = Hash_Block(val2, cased);

			// Iterate over first series:
			ser = VAL_SERIES(val1);
			i = VAL_INDEX(val1);
			for (; val = BLK_SKIP(ser, i), i < SERIES_TAIL(ser); i += skip) {
				if (GET_FLAG(flags, SOP_CHECK)) {
					h = Find_Key(VAL_SERIES(val2), hser, val, skip, cased, 1) >= 0;
					if (GET_FLAG(flags, SOP_INVERT)) h = !h;
				}
				if (h) Find_Key(retser, hret, val, skip, cased, 2);
			}

			// Iterate over second series?
			if ((i = GET_FLAG(flags, SOP_BOTH))) {
				val = val1;
				val1 = val2;
				val2 = val;
				CLR_FLAG(flags, SOP_BOTH);
			}

			if (GET_FLAG(flags, SOP_CHECK))
				Free_Series(hser);
		} while (i);

		if (hret)
			Free_Series(hret);

		Val_Init_Block(D_OUT, Copy_Array_Shallow(retser));
		RESET_TAIL(retser); // required - allow reuse

		break;

	case REB_BINARY:
		cased = TRUE;
		SET_TYPE(D_OUT, REB_BINARY);
	case REB_STRING:
		i = VAL_LEN(val1);
		// Setup result block:
		if (GET_FLAG(flags, SOP_BOTH)) i += VAL_LEN(val2);

		retser = BUF_MOLD;
		Reset_Buffer(retser, i);
		RESET_TAIL(retser);

		do {
			REBUNI uc;

			cased = cased ? AM_FIND_CASE : 0;

			// Iterate over first series:
			ser = VAL_SERIES(val1);
			i = VAL_INDEX(val1);
			for (; i < SERIES_TAIL(ser); i += skip) {
				uc = GET_ANY_CHAR(ser, i);
				if (GET_FLAG(flags, SOP_CHECK)) {
					h = Find_Str_Char(VAL_SERIES(val2), 0, VAL_INDEX(val2), VAL_TAIL(val2), skip, uc, cased) != NOT_FOUND;
					if (GET_FLAG(flags, SOP_INVERT)) h = !h;
				}
				if (h && (Find_Str_Char(retser, 0, 0, SERIES_TAIL(retser), skip, uc, cased) == NOT_FOUND)) {
					Append_String(retser, ser, i, skip);
				}
			}

			// Iterate over second series?
			if ((i = GET_FLAG(flags, SOP_BOTH))) {
				val = val1;
				val1 = val2;
				val2 = val;
				CLR_FLAG(flags, SOP_BOTH);
			}
		} while (i);

		ser = Copy_String(retser, 0, -1);
		if (IS_BINARY(D_OUT))
			Val_Init_Binary(D_OUT, ser);
		else
			Val_Init_String(D_OUT, ser);
		break;

	case REB_BITSET:
		switch (flags) {
		case SET_OP_UNIQUE:
			return R_ARG1;
		case SET_OP_UNION:
			i = A_OR;
			break;
		case SET_OP_INTERSECT:
			i = A_AND;
			break;
		case SET_OP_DIFFERENCE:
			i = A_XOR;
			break;
		case SET_OP_EXCLUDE:
			i = 0; // special case
			break;
		}
		ser = Xandor_Binary(i, val1, val2);
		Val_Init_Bitset(D_OUT, ser);
		break;

	case REB_TYPESET:
		switch (flags) {
		case SET_OP_UNIQUE:
			break;
		case SET_OP_UNION:
			VAL_TYPESET(val1) |= VAL_TYPESET(val2);
			break;
		case SET_OP_INTERSECT:
			VAL_TYPESET(val1) &= VAL_TYPESET(val2);
			break;
		case SET_OP_DIFFERENCE:
			VAL_TYPESET(val1) ^= VAL_TYPESET(val2);
			break;
		case SET_OP_EXCLUDE:
			VAL_TYPESET(val1) &= ~VAL_TYPESET(val2);
			break;
		}
		return R_ARG1;

	default:
		raise Error_Invalid_Arg(val1);
	}

	return R_OUT;
}
예제 #27
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;
}
예제 #28
0
파일: f-stubs.c 프로젝트: 51weekend/r3
*/	 REBCNT Get_Part_Length(REBVAL *bval, REBVAL *eval)
/*
**		Determine the length of a /PART value.
**		If /PART value is an integer just use it.
**		If it is a series and it is the same series as the first,
**		use the difference between the two indices.
**
**		If the length ends up negative, back up the index as much
**		as possible. If backed up over the head, adjust the length.
**
**		Note: This one does not handle list datatypes.
**
***********************************************************************/
{
	REBINT	len;
	REBCNT	tail;

	if (IS_INTEGER(eval) || IS_DECIMAL(eval)) {
		len = Int32(eval);
		if (IS_SCALAR(bval) && VAL_TYPE(bval) != REB_PORT)
			Trap1(RE_INVALID_PART, bval);
	}
	else if (
		(
			// IF normal series and self referencing:
			VAL_TYPE(eval) >= REB_STRING &&
			VAL_TYPE(eval) <= REB_BLOCK &&
			VAL_TYPE(bval) == VAL_TYPE(eval) &&
			VAL_SERIES(bval) == VAL_SERIES(eval)
		) || (
			// OR IF it is a port:
			IS_PORT(bval) && IS_PORT(eval) &&
			VAL_OBJ_FRAME(bval) == VAL_OBJ_FRAME(eval)
		)
	)
		len = (REBINT)VAL_INDEX(eval) - (REBINT)VAL_INDEX(bval);
	else
		Trap1(RE_INVALID_PART, eval);
/* !!!!
	if (IS_PORT(bval)) {
		PORT_STATE_OBJ	*port;

		port = VAL_PORT(&VAL_PSP(bval)->state);
		if (PORT_FLAG(port) & PF_DIRECT)
			tail = 0x7fffffff;
		else
			tail = PORT_TAIL(VAL_PORT(&VAL_PSP(bval)->state));
	}
	else
*/		tail = VAL_TAIL(bval);

	if (len < 0) {
		len = -len;
		if (len > (REBINT)VAL_INDEX(bval))
			len = (REBINT)VAL_INDEX(bval);
		VAL_INDEX(bval) -= (REBCNT)len;
	}
	else if (!IS_INTEGER(eval) && (len + VAL_INDEX(bval)) > tail)
		len = (REBINT)(tail - VAL_INDEX(bval));

	return (REBCNT)len;
}
예제 #29
0
파일: f-stubs.c 프로젝트: 51weekend/r3
*/	 REBINT Partial(REBVAL *aval, REBVAL *bval, REBVAL *lval, REBFLG flag)
/*
**		Args:
**			aval: target value
**			bval: argument to modify target (optional)
**			lval: length value (or none)
**
**		Determine the length of a /PART value. It can be:
**			1. integer or decimal
**			2. relative to A value (bval is null)
**			3. relative to B value
**
**		Flag: indicates special treatment for CHANGE. As in:
**			CHANGE/part "abcde" "xy" 3 => "xyde"
**
**		NOTE: Can modify the value's index!
**		The result can be negative. ???
**
***********************************************************************/
{
	REBVAL *val;
	REBINT len;
	REBINT maxlen;

	// If lval = NONE, use the current len of the target value:
	if (IS_NONE(lval)) {
		val = (bval && ANY_SERIES(bval)) ? bval : aval;
		if (VAL_INDEX(val) >= VAL_TAIL(val)) return 0;
		return (VAL_TAIL(val) - VAL_INDEX(val));
	}

	if (IS_INTEGER(lval)) {
		len = Int32(lval);
		val = flag ? aval : bval;
	}

	else if (IS_DECIMAL(lval)) {
		len = Int32(lval);
		val = bval;
	}

	else {
		// So, lval must be relative to aval or bval series:
		if (VAL_TYPE(aval) == VAL_TYPE(lval) && VAL_SERIES(aval) == VAL_SERIES(lval))
			val = aval;
		else if (bval && VAL_TYPE(bval) == VAL_TYPE(lval) && VAL_SERIES(bval) == VAL_SERIES(lval))
			val = bval;
		else
			Trap1(RE_INVALID_PART, lval);

		len = (REBINT)VAL_INDEX(lval) - (REBINT)VAL_INDEX(val);
	}

	if (!val) val = aval;

	// Restrict length to the size available:
	if (len >= 0) {
		maxlen = (REBINT)VAL_LEN(val);
		if (len > maxlen) len = maxlen;
	} else {
		len = -len;
		if (len > (REBINT)VAL_INDEX(val)) len = (REBINT)VAL_INDEX(val);
		VAL_INDEX(val) -= (REBCNT)len;
//		if ((-len) > (REBINT)VAL_INDEX(val)) len = -(REBINT)VAL_INDEX(val);
	}

	return len;
}
예제 #30
0
static REBSER *make_binary(REBVAL *arg, REBOOL make)
{
	REBSER *ser;

	// MAKE BINARY! 123
	switch (VAL_TYPE(arg)) {
	case REB_INTEGER:
	case REB_DECIMAL:
		if (make) ser = Make_Binary(Int32s(arg, 0));
		else ser = Make_Binary_BE64(arg);
		break;

	// MAKE/TO BINARY! BINARY!
	case REB_BINARY:
		ser = Copy_Bytes(VAL_BIN_DATA(arg), VAL_LEN(arg));
		break;

	// MAKE/TO BINARY! <any-string>
	case REB_STRING:
	case REB_FILE:
	case REB_EMAIL:
	case REB_URL:
	case REB_TAG:
//	case REB_ISSUE:
		ser = Encode_UTF8_Value(arg, VAL_LEN(arg), 0);
		break;

	case REB_BLOCK:
		ser = Join_Binary(arg);
		break;

	// MAKE/TO BINARY! <tuple!>
	case REB_TUPLE:
		ser = Copy_Bytes(VAL_TUPLE(arg), VAL_TUPLE_LEN(arg));
		break;

	// MAKE/TO BINARY! <char!>
	case REB_CHAR:
		ser = Make_Binary(6);
		ser->tail = Encode_UTF8_Char(BIN_HEAD(ser), VAL_CHAR(arg));
		break;

	// MAKE/TO BINARY! <bitset!>
	case REB_BITSET:
		ser = Copy_Bytes(VAL_BIN(arg), VAL_TAIL(arg));
		break;

	// MAKE/TO BINARY! <image!>
	case REB_IMAGE:
	  	ser = Make_Image_Binary(arg);
		break;

	case REB_MONEY:
		ser = Make_Binary(12);
		ser->tail = 12;
		deci_to_binary(ser->data, VAL_DECI(arg));
		ser->data[12] = 0;
		break;

	default:
		ser = 0;
	}

	return ser;
}