Ejemplo n.º 1
0
*/	REBINT Compare_String_Vals(REBVAL *v1, REBVAL *v2, REBOOL uncase)
/*
**		Compare two string values. Either can be byte or unicode wide.
**
**		Uncase: compare is case-insensitive.
**
**		Used for: general string comparions (various places)
**
***********************************************************************/
{
	REBCNT l1  = VAL_LEN(v1);
	REBCNT l2  = VAL_LEN(v2);
	REBCNT len = MIN(l1, l2);
	REBINT n;

	if (IS_BINARY(v1) || IS_BINARY(v2)) uncase = FALSE;

	if (VAL_BYTE_SIZE(v1)) { // v1 is 8
		if (VAL_BYTE_SIZE(v2))
			n = Compare_Bytes(VAL_BIN_DATA(v1), VAL_BIN_DATA(v2), len, uncase);
		else
			n = -Compare_Uni_Byte(VAL_UNI_DATA(v2), VAL_BIN_DATA(v1), len, uncase);
	}
	else { // v1 is 16
		if (VAL_BYTE_SIZE(v2))
			n = Compare_Uni_Byte(VAL_UNI_DATA(v1), VAL_BIN_DATA(v2), len, uncase);
		else
			n = Compare_Uni_Str(VAL_UNI_DATA(v1), VAL_UNI_DATA(v2), len, uncase);
	}

	if (n != 0) return n;
	return l1 - l2;
}
Ejemplo n.º 2
0
*/  REBSER *Xandor_Binary(REBCNT action, REBVAL *value, REBVAL *arg)
/*
**		Only valid for BINARY data.
**
***********************************************************************/
{
		REBSER *series;
		REBYTE *p0 = VAL_BIN_DATA(value);
		REBYTE *p1 = VAL_BIN_DATA(arg);
		REBYTE *p2;
		REBCNT i;
		REBCNT mt, t1, t0, t2;

		t0 = VAL_LEN(value);
		t1 = VAL_LEN(arg);

		mt = MIN(t0, t1); // smaller array size
		// For AND - result is size of shortest input:
//		if (action == A_AND || (action == 0 && t1 >= t0))
//			t2 = mt;
//		else
		t2 = MAX(t0, t1);

		series = Make_Binary(t2);
		SERIES_TAIL(series) = t2;
		p2 = BIN_HEAD(series);

		switch (action) {
		case A_AND:
			for (i = 0; i < mt; i++) *p2++ = *p0++ & *p1++;
			CLEAR(p2, t2 - mt);
			return series;
		case A_OR:
			for (i = 0; i < mt; i++) *p2++ = *p0++ | *p1++;
			break;
		case A_XOR:
			for (i = 0; i < mt; i++) *p2++ = *p0++ ^ *p1++;
			break;
		default:
			// special bit set case EXCLUDE:
			for (i = 0; i < mt; i++) *p2++ = *p0++ & ~*p1++;
			if (t0 > t1) memcpy(p2, p0, t0 - t1); // residual from first only
			return series;
		}

		// Copy the residual:
		memcpy(p2, ((t0 > t1) ? p0 : p1), t2 - mt);
		return series;
}
Ejemplo n.º 3
0
*/	REBFLG Make_Function(REBCNT type, REBVAL *value, REBVAL *def)
/*
***********************************************************************/
{
	REBVAL *spec;
	REBVAL *body;
	REBCNT len;

	if (
		!IS_BLOCK(def)
////		|| type < REB_CLOSURE // for now
		|| (len = VAL_LEN(def)) < 2
		|| !IS_BLOCK(spec = VAL_BLK(def))
	) return FALSE;

	body = VAL_BLK_SKIP(def, 1);

	//	Print("Make_Func"); //: %s spec %d", Get_Sym_Name(type+1), SERIES_TAIL(spec));
	VAL_FUNC_SPEC(value) = VAL_SERIES(spec);
	VAL_FUNC_ARGS(value) = Check_Func_Spec(VAL_SERIES(spec));

	if (type != REB_COMMAND) {
		if (len != 2 || !IS_BLOCK(body)) return FALSE;
		VAL_FUNC_BODY(value) = VAL_SERIES(body);
	}
	else
		Make_Command(value, def);

	VAL_SET(value, type);

	if (type == REB_FUNCTION)
		Bind_Relative(VAL_FUNC_ARGS(value), VAL_FUNC_BODY(value), VAL_FUNC_BODY(value));

	return TRUE;
}
Ejemplo n.º 4
0
static int Check_Char_Range(REBVAL *val, REBINT limit)
{
	REBCNT len;

	if (IS_CHAR(val)) {
		if (VAL_CHAR(val) > limit) return R_FALSE;
		return R_TRUE;
	}

	if (IS_INTEGER(val)) {
		if (VAL_INT64(val) > limit) return R_FALSE;
		return R_TRUE;
	}

	len = VAL_LEN(val);
	if (VAL_BYTE_SIZE(val)) {
		REBYTE *bp = VAL_BIN_DATA(val);
		if (limit == 0xff) return R_TRUE; // by definition
		for (; len > 0; len--, bp++)
			if (*bp > limit) return R_FALSE;
	} else {
		REBUNI *up = VAL_UNI_DATA(val);
		for (; len > 0; len--, up++)
			if (*up > limit) return R_FALSE;
	}

	return R_TRUE;
}
Ejemplo n.º 5
0
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;
}
Ejemplo n.º 6
0
STOID Mold_Tag(REBVAL *value, REB_MOLD *mold)
{
	Append_Byte(mold->series, '<');
	Insert_String(mold->series, AT_TAIL, VAL_SERIES(value), VAL_INDEX(value), VAL_LEN(value), 0);
	Append_Byte(mold->series, '>');

}
Ejemplo n.º 7
0
*/	REBFLG Make_Function(REBCNT type, REBVAL *value, REBVAL *def)
/*
***********************************************************************/
{
	REBVAL *spec;
	REBVAL *body;
	REBCNT len;

	if (
		!IS_BLOCK(def)
		|| (len = VAL_LEN(def)) < 2
		|| !IS_BLOCK(spec = VAL_BLK(def))
	) return FALSE;

	body = VAL_BLK_SKIP(def, 1);

	VAL_FUNC_SPEC(value) = VAL_SERIES(spec);
	VAL_FUNC_ARGS(value) = Check_Func_Spec(VAL_SERIES(spec));

	if (type != REB_COMMAND) {
		if (len != 2 || !IS_BLOCK(body)) return FALSE;
		VAL_FUNC_BODY(value) = VAL_SERIES(body);
	}
	else
		Make_Command(value, def);

	VAL_SET(value, type);

	if (type == REB_FUNCTION || type == REB_CLOSURE)
		Bind_Relative(VAL_FUNC_ARGS(value), VAL_FUNC_ARGS(value), VAL_FUNC_BODY(value));

	return TRUE;
}
Ejemplo n.º 8
0
static REBSER *make_string(REBVAL *arg, REBOOL make)
{
	REBSER *ser = 0;

	// MAKE <type> 123
	if (make && (IS_INTEGER(arg) || IS_DECIMAL(arg))) {
		ser = Make_Binary(Int32s(arg, 0));
	}
	// MAKE/TO <type> <binary!>
	else if (IS_BINARY(arg)) {
		REBYTE *bp = VAL_BIN_DATA(arg);
		REBCNT len = VAL_LEN(arg);
		switch (What_UTF(bp, len)) {
		case 0:
			break;
		case 8: // UTF-8 encoded
			bp  += 3;
			len -= 3;
			break;
		default:
			Trap0(RE_BAD_DECODE);
		}
		ser = Decode_UTF_String(bp, len, 8); // UTF-8
	}
	// MAKE/TO <type> <any-string>
	else if (ANY_BINSTR(arg)) {
		ser = Copy_String(VAL_SERIES(arg), VAL_INDEX(arg), VAL_LEN(arg));
	}
	// MAKE/TO <type> <any-word>
	else if (ANY_WORD(arg)) {
		ser = Copy_Mold_Value(arg, TRUE);
		//ser = Append_UTF8(0, Get_Word_Name(arg), -1);
	}
	// MAKE/TO <type> #"A"
	else if (IS_CHAR(arg)) {
		ser = (VAL_CHAR(arg) > 0xff) ? Make_Unicode(2) : Make_Binary(2);
		Append_Byte(ser, VAL_CHAR(arg));
	}
	// MAKE/TO <type> <any-value>
//	else if (IS_NONE(arg)) {
//		ser = Make_Binary(0);
//	}
	else
		ser = Copy_Form_Value(arg, 1<<MOPT_TIGHT);

	return ser;
}
Ejemplo n.º 9
0
*/	REBOOL Cloak(REBOOL decode, REBYTE *cp, REBCNT dlen, REBYTE *kp, REBCNT klen, REBFLG as_is)
/*
**		Simple data scrambler. Quality depends on the key length.
**		Result is made in place (data string).
**
**		The key (kp) is passed as a REBVAL or REBYTE (when klen is !0).
**
***********************************************************************/
{
	REBCNT i, n;
	REBYTE src[20];
	REBYTE dst[20];

	if (dlen == 0) return TRUE;

	// Decode KEY as VALUE field (binary, string, or integer)
	if (klen == 0) {
		REBVAL *val = (REBVAL*)kp;
		REBSER *ser;

		switch (VAL_TYPE(val)) {
		case REB_BINARY:
			kp = VAL_BIN_DATA(val);
			klen = VAL_LEN(val);
			break;
		case REB_STRING:
			ser = Temp_Bin_Str_Managed(val, &i, &klen);
			kp = BIN_SKIP(ser, i);
			break;
		case REB_INTEGER:
			INT_TO_STR(VAL_INT64(val), dst);
			klen = LEN_BYTES(dst);
			as_is = FALSE;
			break;
		}

		if (klen == 0) return FALSE;
	}

	if (!as_is) {
		for (i = 0; i < 20; i++) src[i] = kp[i % klen];
		SHA1(src, 20, dst);
		klen = 20;
		kp = dst;
	}

	if (decode)
		for (i = dlen-1; i > 0; i--) cp[i] ^= cp[i-1] ^ kp[i % klen];

	// Change starting byte based all other bytes.
	n = 0xa5;
	for (i = 1; i < dlen; i++) n += cp[i];
	cp[0] ^= (REBYTE)n;

	if (!decode)
		for (i = 1; i < dlen; i++) cp[i] ^= cp[i-1] ^ kp[i % klen];

	return TRUE;
}
Ejemplo n.º 10
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;
}
Ejemplo n.º 11
0
*/	static void replace_with(REBSER *ser, REBCNT index, REBCNT tail, REBVAL *with)
/*
**		Replace whitespace chars that match WITH string.
**
**		Resulting string is always smaller than it was to start.
**
***********************************************************************/
{
	#define MAX_WITH 32
	REBCNT wlen;
	REBUNI with_chars[MAX_WITH];	// chars to be trimmed
	REBUNI *up = with_chars;
	REBYTE *bp;
	REBCNT n;
	REBUNI uc;

	// Setup WITH array from arg or the default:
	n = 0;
	if (IS_NONE(with)) {
		bp = "\n \r\t";
		wlen = n = 4;
	}
	else if (IS_CHAR(with)) {
		wlen = 1;
		*up++ = VAL_CHAR(with);
	}
	else if (IS_INTEGER(with)) {
		wlen = 1;
		*up++ = Int32s(with, 0);
	}
	else if (ANY_BINSTR(with)) {
		n = VAL_LEN(with);
		if (n >= MAX_WITH) n = MAX_WITH-1;
		wlen = n;
		if (VAL_BYTE_SIZE(with)) {
			bp = VAL_BIN_DATA(with);
		} else {
			memcpy(up, VAL_UNI_DATA(with), n * sizeof(REBUNI));
			n = 0;
		}
	}
	for (; n > 0; n--) *up++ = (REBUNI)*bp++;

	// Remove all occurances of chars found in WITH string:
	for (n = index; index < tail; index++) {
		uc = GET_ANY_CHAR(ser, index);
		if (!find_in_uni(with_chars, wlen, uc)) {
			SET_ANY_CHAR(ser, n, uc);
			n++;
		}
	}

	SET_ANY_CHAR(ser, n, 0);	
	SERIES_TAIL(ser) = n;
}
Ejemplo n.º 12
0
*/	static REBSER *Init_Loop(const 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) raise Error_Invalid_Arg(spec);
	frame = Make_Frame(len, FALSE);
	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);
			raise Error_Invalid_Arg(spec);
		}
		Val_Init_Word_Typed(word, VAL_TYPE(spec), VAL_WORD_SYM(spec), ALL_64);
		word++;
		SET_NONE(vals);
		vals++;
		spec++;
	}
	SET_END(word);
	SET_END(vals);

	body = Copy_Array_At_Deep_Managed(
		VAL_SERIES(body_blk), VAL_INDEX(body_blk)
	);
	Bind_Values_Deep(BLK_HEAD(body), frame);

	*fram = frame;

	return body;
}
Ejemplo n.º 13
0
*/	REBSER *Copy_Sequence_At_Position(const REBVAL *position)
/*
**		Copy a non-array series from its value structure, using the
**		value's index as the location to start copying the data.
**
***********************************************************************/
{
	return Copy_Sequence_At_Len(
		VAL_SERIES(position), VAL_INDEX(position), VAL_LEN(position)
	);
}
Ejemplo n.º 14
0
*/	REBSER *Temp_Bin_Str_Managed(REBVAL *val, REBCNT *index, REBCNT *length)
/*
**	Determines if UTF8 conversion is needed for a series before it
**	is used with a byte-oriented function.
**
**	If conversion is needed, a UTF8 series will be created.  Otherwise,
**	the source series is returned as-is.
**
**	Note: This routine should only be used to generate a value used
**	for temporary purposes, because it has a "surprising variance"
**	regarding its input.  If the value's series can be reused, it is--
**	and this depends on an implementation detail of internal encoding
**	that the user should not be aware of (they need not know if the
**	internal representation of an ASCII string uses 1, 2, or however
**	many bytes).  But copying vs. non-copying means the resulting
**	data might or might not have previous values available to step
**	back into from the originating series!
**
**	!!! Should performance dictate it, the callsites could be
**	adapted to know whether this produced a new series or not, and
**	instead of managing a created result they could be responsible
**	for freeing it if so.
**
***********************************************************************/
{
	REBCNT len = (length && *length) ? *length : VAL_LEN(val);
	REBSER *series;

	assert(IS_BINARY(val) || ANY_STR(val));

	if (len == 0 || IS_BINARY(val) || VAL_STR_IS_ASCII(val)) {
		// If it's zero length, BINARY!, or an ANY-STRING! whose bytes are
		// all values less than 128, we reuse the series.

		series = VAL_SERIES(val);
		ASSERT_SERIES_MANAGED(series);

		if (index) *index = VAL_INDEX(val);
		if (length) *length = len;
	}
	else {
		// UTF-8 conversion is required, and we manage the result.

		series = Make_UTF8_From_Any_String(val, len, OPT_ENC_CRLF_MAYBE);
		MANAGE_SERIES(series);

		if (index) *index = 0;
		if (length) *length = SERIES_TAIL(series);
	}

	return series;
}
Ejemplo n.º 15
0
*/	REBINT Compare_Binary_Vals(REBVAL *v1, REBVAL *v2)
/*
**		Compare two binary values.
**
**		Compares bytes, not chars. Return the difference.
**
**		Used for: Binary comparision function
**
***********************************************************************/
{
	REBCNT l1 = VAL_LEN(v1);
	REBCNT l2 = VAL_LEN(v2);
	REBCNT len = MIN(l1, l2);
	REBINT n;

	if (IS_IMAGE(v1)) len *= 4;

	n = memcmp(VAL_BIN_DATA(v1), VAL_BIN_DATA(v2), len);

	if (n != 0) return n;

	return l1 - l2;
}
Ejemplo n.º 16
0
*/  static void Binary_To_Decimal(REBVAL *bin, REBVAL *dec)
/*
***********************************************************************/
{
    REBI64 n = 0;
    REBSER *ser = VAL_SERIES(bin);
    REBCNT idx = VAL_INDEX(bin);
    REBCNT len = VAL_LEN(bin);

    if (len > 8) len = 8;

    for (; len; len--, idx++) n = (n << 8) | (REBI64)(GET_ANY_CHAR(ser, idx));

    VAL_SET(dec, REB_DECIMAL);
    VAL_INT64(dec) = n; // aliasing the bits!
}
Ejemplo n.º 17
0
*/	void Shuffle_Block(REBVAL *value, REBFLG secure)
/*
***********************************************************************/
{
	REBCNT n;
	REBCNT k;
	REBCNT idx = VAL_INDEX(value);
	REBVAL *data = VAL_BLK(value);
	REBVAL swap;

	for (n = VAL_LEN(value); n > 1;) {
		k = idx + (REBCNT)Random_Int(secure) % n;
		n--;
		swap = data[k];
		data[k] = data[n + idx];
		data[n + idx] = swap;
	}
}
Ejemplo n.º 18
0
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;
}
Ejemplo n.º 19
0
*/	REBSER *Complement_Binary(REBVAL *value)
/*
**		Only valid for BINARY data.
**
***********************************************************************/
{
		REBSER *series;
		REBYTE *str = VAL_BIN_DATA(value);
		REBINT len = VAL_LEN(value);
		REBYTE *out;

		series = Make_Binary(len);
		SERIES_TAIL(series) = len;
		out = BIN_HEAD(series);
		for (; len > 0; len--)
			*out++ = ~ *str++;

		return series;
}
Ejemplo n.º 20
0
*/	REBCHR *Val_Str_To_OS_Managed(REBSER **out, REBVAL *val)
/*
**		This is used to pass a REBOL value string to an OS API.
**
**		The REBOL (input) string can be byte or wide sized.
**		The OS (output) string is in the native OS format.
**		On Windows, its a wide-char, but on Linux, its UTF-8.
**
**		If we know that the string can be used directly as-is,
**		(because it's in the OS size format), we can used it
**		like that.
**
**		!!! The series is created but just let up to the garbage
**		collector to free.  This is a "leaky" approach.  You may
**		optionally request to have the series returned if it is
**		important for you to protect it from GC, but you cannot
**		currently get a "freeable" series out of this.
**
***********************************************************************/
{
#ifdef OS_WIDE_CHAR
    if (VAL_BYTE_SIZE(val)) {
        // On windows, we need to convert byte to wide:
        REBINT n = VAL_LEN(val);
        REBSER *up = Make_Unicode(n);

        // !!!"Leaks" in the sense that the GC has to take care of this
        MANAGE_SERIES(up);

        n = Decode_UTF8(UNI_HEAD(up), VAL_BIN_DATA(val), n, FALSE);
        SERIES_TAIL(up) = abs(n);
        UNI_TERM(up);

        if (out) *out = up;

        return cast(REBCHR*, UNI_HEAD(up));
    }
    else {
        // Already wide, we can use it as-is:
        // !Assumes the OS uses same wide format!

        if (out) *out = VAL_SERIES(val);
Ejemplo n.º 21
0
*/  REBSER *Split_Lines(REBVAL *val)
/*
**      Given a string series, split lines on CR-LF.
**		Series can be bytes or Unicode.
**
***********************************************************************/
{
	REBSER *ser = BUF_EMIT; // GC protected (because it is emit buffer)
	REBSER *str = VAL_SERIES(val);
	REBCNT len = VAL_LEN(val);
	REBCNT idx = VAL_INDEX(val);
	REBCNT start = idx;
	REBSER *out;
	REBUNI c;

	BLK_RESET(ser);

	while (idx < len) {
		c = GET_ANY_CHAR(str, idx);
		if (c == LF || c == CR) {
			out = Copy_String(str, start, idx - start);
			val = Alloc_Tail_Array(ser);
			Val_Init_String(val, out);
			VAL_SET_OPT(val, OPT_VALUE_LINE);
			idx++;
			if (c == CR && GET_ANY_CHAR(str, idx) == LF)
				idx++;
			start = idx;
		}
		else idx++;
	}
	// Possible remainder (no terminator)
	if (idx > start) {
		out = Copy_String(str, start, idx - start);
		val = Alloc_Tail_Array(ser);
		Val_Init_String(val, out);
		VAL_SET_OPT(val, OPT_VALUE_LINE);
	}

	return Copy_Array_Shallow(ser);
}
Ejemplo n.º 22
0
*/	void Make_Command(REBVAL *value, REBVAL *def)
/*
**		Assumes prior function has already stored the spec and args
**		series. This function validates the body.
**
***********************************************************************/
{
	REBVAL *args = BLK_HEAD(VAL_FUNC_ARGS(value));
	REBCNT n;
	REBVAL *val = VAL_BLK_SKIP(def, 1);
	REBEXT *ext;

	if (
		VAL_LEN(def) != 3
		|| !(IS_MODULE(val) || IS_OBJECT(val))
		|| !IS_HANDLE(VAL_OBJ_VALUE(val, 1))
		|| !IS_INTEGER(val+1)
		|| VAL_INT64(val+1) > 0xffff
	) Trap1(RE_BAD_FUNC_DEF, def);

	val = VAL_OBJ_VALUE(val, 1);
	if (
		!(ext = &Ext_List[VAL_I32(val)])
		|| !(ext->call)
	) Trap1(RE_BAD_EXTENSION, def);

	// make command! [[arg-spec] handle cmd-index]
	VAL_FUNC_BODY(value) = Copy_Block_Len(VAL_SERIES(def), 1, 2);

	// Check for valid command arg datatypes:
	args++; // skip self
	n = 1;
	for (; NOT_END(args); args++, n++) {
		// If the typeset contains args that are not valid:
		// (3 is the default when no args given, for not END and UNSET)
		if (3 != ~VAL_TYPESET(args) && (VAL_TYPESET(args) & ~RXT_ALLOWED_TYPES))
			Trap1(RE_BAD_FUNC_ARG, args);
	}

	VAL_SET(value, REB_COMMAND);
}
Ejemplo n.º 23
0
*/	void Shuffle_String(REBVAL *value, REBFLG secure)
/*
**		Randomize a string. Return a new string series.
**		Handles both BYTE and UNICODE strings.
**
***********************************************************************/
{
	REBCNT n;
	REBCNT k;
	REBSER *series = VAL_SERIES(value);
	REBCNT idx     = VAL_INDEX(value);
	REBUNI swap;

	for (n = VAL_LEN(value); n > 1;) {
		k = idx + (REBCNT)Random_Int(secure) % n;
		n--;
		swap = GET_ANY_CHAR(series, k);
		SET_ANY_CHAR(series, k, GET_ANY_CHAR(series, n + idx));
		SET_ANY_CHAR(series, n + idx, swap);
	}
}
Ejemplo n.º 24
0
*/	 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;
}
Ejemplo n.º 25
0
*/	static REBFLG Set_Struct_Var(REBSTU *stu, REBVAL *word, REBVAL *elem, REBVAL *val)
/*
***********************************************************************/
{
	struct Struct_Field *field = NULL;
	REBCNT i = 0;
	field = (struct Struct_Field *)SERIES_DATA(stu->fields);
	for (i = 0; i < SERIES_TAIL(stu->fields); i ++, field ++) {
		if (VAL_WORD_CANON(word) == VAL_SYM_CANON(BLK_SKIP(PG_Word_Table.series, field->sym))) {
			if (field->array) {
				if (elem == NULL) { //set the whole array
					REBCNT n = 0;
					if ((!IS_BLOCK(val) || field->dimension != VAL_LEN(val))) {
						return FALSE;
					}

					for(n = 0; n < field->dimension; n ++) {
						if (!assign_scalar(stu, field, n, VAL_BLK_SKIP(val, n))) {
							return FALSE;
						}
					}

				} else {// set only one element
					if (!IS_INTEGER(elem)
						|| VAL_INT32(elem) <= 0
						|| VAL_INT32(elem) > cast(REBINT, field->dimension)) {
						return FALSE;
					}
					return assign_scalar(stu, field, VAL_INT32(elem) - 1, val);
				}
				return TRUE;
			} else {
				return assign_scalar(stu, field, 0, val);
			}
			return TRUE;
		}
	}
	return FALSE;
}
Ejemplo n.º 26
0
*/  REBINT Bin_To_Money(REBVAL *result, REBVAL *val)
/*
***********************************************************************/
{
	REBCNT len;
	REBYTE buf[MAX_HEX_LEN+4] = {0}; // binary to convert

	if (IS_BINARY(val)) {
		len = VAL_LEN(val);
		if (len > 12) len = 12;
		memcpy(buf, VAL_BIN_DATA(val), len);
	}
#ifdef removed
	else if (IS_ISSUE(val)) {
		//if (!(len = Scan_Hex_Bytes(val, 24, buf))) return FALSE;
		REBYTE *ap = Get_Word_Name(val);
		REBYTE *bp = &buf[0];
		REBCNT alen;
		REBUNI c;
		len = LEN_BYTES(ap);  // UTF-8 len
		if (len & 1) return FALSE; // must have even # of chars
		len /= 2;
		if (len > 12) return FALSE; // valid even for UTF-8
		for (alen = 0; alen < len; alen++) {
			if (!Scan_Hex2(ap, &c, 0)) return FALSE;
			*bp++ = (REBYTE)c;
			ap += 2;
		}
	}
#endif
	else
		raise Error_Invalid_Arg(val);

	memcpy(buf + 12 - len, buf, len); // shift to right side
	memset(buf, 0, 12 - len);
	VAL_MONEY_AMOUNT(result) = binary_to_deci(buf);
	return TRUE;
}
Ejemplo n.º 27
0
*/	void Mold_Binary(REBVAL *value, REB_MOLD *mold)
/*
***********************************************************************/
{
	REBCNT len = VAL_LEN(value);
	REBSER *out;

	switch (Get_System_Int(SYS_OPTIONS, OPTIONS_BINARY_BASE, 16)) {
	default:
	case 16:
		out = Encode_Base16(value, 0, len > 32);
		break;
	case 64:
		Append_Bytes(mold->series, "64");
		out = Encode_Base64(value, 0, len > 64);
		break;
	case 2:
		Append_Byte(mold->series, '2');
		out = Encode_Base2(value, 0, len > 8);
		break;
	}

	Emit(mold, "#{E}", out);
}
Ejemplo n.º 28
0
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;
}
Ejemplo n.º 29
0
*/	REBSER *At_Head(REBVAL *value)
/*
**		Return the series for a value, but if it has an index
**		offset, return a copy of the series from that position.
**		Useful for functions that do not accept index offsets.
**
***********************************************************************/
{
	REBCNT len;
	REBSER *ser;
	REBSER *src = VAL_SERIES(value);
	REBCNT wide;

	if (VAL_INDEX(value) == 0) return src;

	len = VAL_LEN(value);
	wide = SERIES_WIDE(src);
	ser = Make_Series(len, wide, FALSE);

	memcpy(ser->data, src->data + (VAL_INDEX(value) * wide), len * wide);
	ser->tail = len;

	return ser;
}
Ejemplo n.º 30
0
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;
}