Пример #1
0
*/	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
//
//  Compare_Vector: C
//
REBINT Compare_Vector(const RELVAL *v1, const RELVAL *v2)
{
    REBCNT l1 = VAL_LEN_AT(v1);
    REBCNT l2 = VAL_LEN_AT(v2);
    REBCNT len = MIN(l1, l2);
    REBCNT n;
    REBU64 i1;
    REBU64 i2;
    REBYTE *d1 = SER_DATA_RAW(VAL_SERIES(v1));
    REBYTE *d2 = SER_DATA_RAW(VAL_SERIES(v2));
    REBCNT b1 = VECT_TYPE(VAL_SERIES(v1));
    REBCNT b2 = VECT_TYPE(VAL_SERIES(v2));

    if ((b1 >= VTSF08 && b2 < VTSF08) || (b2 >= VTSF08 && b1 < VTSF08))
        fail (Error(RE_NOT_SAME_TYPE));

    for (n = 0; n < len; n++) {
        i1 = get_vect(b1, d1, n + VAL_INDEX(v1));
        i2 = get_vect(b2, d2, n + VAL_INDEX(v2));
        if (i1 != i2) break;
    }

    if (n != len) {
        if (i1 > i2) return 1;
        return -1;
    }

    return l1 - l2;
}
Пример #3
0
*/	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;
}
Пример #4
0
static REBCNT find_string(REBSER *series, REBCNT index, REBCNT end, REBVAL *target, REBCNT len, REBCNT flags, REBINT skip)
{
	REBCNT start = index;

	if (flags & (AM_FIND_REVERSE | AM_FIND_LAST)) {
		skip = -1;
		start = 0;
		if (flags & AM_FIND_LAST) index = end - len;
		else index--;
	}

	if (ANY_BINSTR(target)) {
		// Do the optimal search or the general search?
		if (BYTE_SIZE(series) && VAL_BYTE_SIZE(target) && !(flags & ~(AM_FIND_CASE|AM_FIND_MATCH)))
			return Find_Byte_Str(series, start, VAL_BIN_DATA(target), len, !GET_FLAG(flags, ARG_FIND_CASE-1), GET_FLAG(flags, ARG_FIND_MATCH-1));
		else
			return Find_Str_Str(series, start, index, end, skip, VAL_SERIES(target), VAL_INDEX(target), len, flags & (AM_FIND_MATCH|AM_FIND_CASE));
	}
	else if (IS_BINARY(target)) {
		return Find_Byte_Str(series, start, VAL_BIN_DATA(target), len, 0, GET_FLAG(flags, ARG_FIND_MATCH-1));
	}
	else if (IS_CHAR(target)) {
		return Find_Str_Char(series, start, index, end, skip, VAL_CHAR(target), flags);
	}
	else if (IS_INTEGER(target)) {
		return Find_Str_Char(series, start, index, end, skip, (REBUNI)VAL_INT32(target), flags);
	}
	else if (IS_BITSET(target)) {
		return Find_Str_Bitset(series, start, index, end, skip, VAL_SERIES(target), flags);
	}

	return NOT_FOUND;
}
Пример #5
0
*/	REBFLG Copy_Function(REBVAL *value, REBVAL *args)
/*
***********************************************************************/
{
	REBVAL *spec = VAL_BLK(args);
	REBVAL *body = VAL_BLK_SKIP(args, 1);

	if (IS_END(spec)) body = 0;
	else {
		// Spec given, must be block or *
		if (IS_BLOCK(spec)) {
			VAL_FUNC_SPEC(value) = VAL_SERIES(spec);
			VAL_FUNC_ARGS(value) = Check_Func_Spec(VAL_SERIES(spec));
		} else
			if (!IS_STAR(spec)) return FALSE;
	}

	if (body && !IS_END(body)) {
		if (!IS_FUNCTION(value) && !IS_CLOSURE(value)) return FALSE;
		// Body must be block:
		if (!IS_BLOCK(body)) return FALSE;
		VAL_FUNC_BODY(value) = VAL_SERIES(body);
	}
	// No body, use protytpe:
	else if (IS_FUNCTION(value) || IS_CLOSURE(value))
		VAL_FUNC_BODY(value) = Clone_Block(VAL_FUNC_BODY(value));

	// Rebind function words:
	if (IS_FUNCTION(value))
		Bind_Relative(VAL_FUNC_ARGS(value), VAL_FUNC_BODY(value), VAL_FUNC_BODY(value));

	return TRUE;
}
Пример #6
0
*/	REBINT CT_Frame(REBVAL *a, REBVAL *b, REBINT mode)
/*
***********************************************************************/
{
	if (mode < 0) return -1;
	return VAL_SERIES(a) == VAL_SERIES(b);
}
Пример #7
0
//
//  Partial1: C
// 
// Process the /part (or /skip) and other length modifying
// arguments.
//
REBINT Partial1(REBVAL *sval, REBVAL *lval)
{
    REBI64 len;
    REBINT maxlen;
    REBINT is_ser = ANY_SERIES(sval);

    // If lval is not set or is BAR!, use the current len of the target value:
    if (IS_UNSET(lval) || IS_BAR(lval)) {
        if (!is_ser) return 1;
        if (VAL_INDEX(sval) >= VAL_LEN_HEAD(sval)) return 0;
        return (VAL_LEN_HEAD(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
            fail (Error(RE_INVALID_PART, lval));
    }

    if (is_ser) {
        // Restrict length to the size available:
        if (len >= 0) {
            maxlen = (REBINT)VAL_LEN_AT(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;
}
Пример #8
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;
}
Пример #9
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;
}
Пример #10
0
*/	REBINT Cmp_Block(REBVAL *sval, REBVAL *tval, REBFLG is_case)
/*
**		Compare two blocks and return the difference of the first
**		non-matching value.
**
***********************************************************************/
{
	REBVAL	*s = VAL_BLK_DATA(sval);
	REBVAL	*t = VAL_BLK_DATA(tval);
	REBINT	diff;

	CHECK_STACK(&s);

	if ((VAL_SERIES(sval)==VAL_SERIES(tval))&&
	 (VAL_INDEX(sval)==VAL_INDEX(tval)))
		 return 0;

	while (!IS_END(s) && (VAL_TYPE(s) == VAL_TYPE(t) ||
					(IS_NUMBER(s) && IS_NUMBER(t)))) {
		if ((diff = Cmp_Value(s, t, is_case)) != 0)
			return diff;
		s++, t++;
	}
	return VAL_TYPE(s) - VAL_TYPE(t);
}
Пример #11
0
*/	REBINT CT_Map(REBVAL *a, REBVAL *b, REBINT mode)
/*
***********************************************************************/
{
	if (mode < 0) return -1;
	if (mode == 3) return VAL_SERIES(a) == VAL_SERIES(b);
	return 0 == Cmp_Block(a, b, 0);
}
Пример #12
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;
}
Пример #13
0
//
//  CT_Bitset: C
//
REBINT CT_Bitset(const REBVAL *a, const REBVAL *b, REBINT mode)
{
    if (mode == 3) return VAL_SERIES(a) == VAL_SERIES(b);
    if (mode >= 0) return (
        BITS_NOT(VAL_SERIES(a)) == BITS_NOT(VAL_SERIES(b))
        &&
        Compare_Binary_Vals(a, b) == 0
    );
    return -1;
}
Пример #14
0
//
//  Partial: C
// 
// 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
// 
// NOTE: Can modify the value's index!
// The result can be negative. ???
//
REBINT Partial(REBVAL *aval, REBVAL *bval, REBVAL *lval)
{
    REBVAL *val;
    REBINT len;
    REBINT maxlen;

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

    if (IS_INTEGER(lval) || 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
            fail (Error(RE_INVALID_PART, lval));

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

    if (!val) val = aval;

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

    return len;
}
Пример #15
0
*/	REBINT CT_String(REBVAL *a, REBVAL *b, REBINT mode)
/*
***********************************************************************/
{
	REBINT num;

	if (mode == 3)
		return VAL_SERIES(a) == VAL_SERIES(b) && VAL_INDEX(a) == VAL_INDEX(b);

	num = Compare_String_Vals(a, b, (REBOOL) !(mode > 1));
	if (mode >= 0) return (num == 0);
	if (mode == -1) return (num >= 0);
	return (num > 0);
}
Пример #16
0
*/	REBINT CT_Block(REBVAL *a, REBVAL *b, REBINT mode)
/*
***********************************************************************/
{
	REBINT num;

	if (mode == 3)
		return VAL_SERIES(a) == VAL_SERIES(b) && VAL_INDEX(a) == VAL_INDEX(b);

	num = Cmp_Block(a, b, mode > 1);
	if (mode >= 0) return (num == 0);
	if (mode == -1) return (num >= 0);
	return (num > 0);
}
Пример #17
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;
}
Пример #18
0
static void swap_chars(REBVAL *val1, REBVAL *val2)
{
	REBUNI c1;
	REBUNI c2;
	REBSER *s1 = VAL_SERIES(val1);
	REBSER *s2 = VAL_SERIES(val2);

	c1 = GET_ANY_CHAR(s1, VAL_INDEX(val1));
	c2 = GET_ANY_CHAR(s2, VAL_INDEX(val2));

	if (BYTE_SIZE(s1) && c2 > 0xff) Widen_String(s1);
	SET_ANY_CHAR(s1, VAL_INDEX(val1), c2);
	
	if (BYTE_SIZE(s2) && c1 > 0xff) Widen_String(s2);
	SET_ANY_CHAR(s2, VAL_INDEX(val2), c1);
}
Пример #19
0
*/	REBINT PD_File(REBPVS *pvs)
/*
***********************************************************************/
{
	REBSER *ser;
	REB_MOLD mo = {0};
	REBCNT n;
	REBUNI c;
	REBSER *arg;

	if (pvs->setval) return PE_BAD_SET;

	ser = Copy_Series_Value(pvs->value);

	n = SERIES_TAIL(ser);
	if (n > 0) c = GET_ANY_CHAR(ser, n-1);
	if (n == 0 || c != '/') Append_Byte(ser, '/');

	if (ANY_STR(pvs->select))
		arg = VAL_SERIES(pvs->select);
	else {
		Reset_Mold(&mo);
		Mold_Value(&mo, pvs->select, 0);
		arg = mo.series;
	}

	c = GET_ANY_CHAR(arg, 0);
	n = (c == '/' || c == '\\') ? 1 : 0;
	Append_String(ser, arg, n, arg->tail-n);

	Set_Series(VAL_TYPE(pvs->value), pvs->store, ser);

	return PE_USE;
}
Пример #20
0
//
//  Pick_Vector: C
//
void Pick_Vector(REBVAL *out, const REBVAL *value, const REBVAL *picker) {
    REBSER *vect = VAL_SERIES(value);

    REBINT n;
    if (IS_INTEGER(picker) || IS_DECIMAL(picker))
        n = Int32(picker);
    else
        fail (Error_Invalid_Arg(picker));

    n += VAL_INDEX(value);

    if (n <= 0 || cast(REBCNT, n) > SER_LEN(vect)) {
        SET_VOID(out); // out of range of vector data
        return;
    }

    REBYTE *vp = SER_DATA_RAW(vect);
    REBINT bits = VECT_TYPE(vect);

    if (bits < VTSF08)
        SET_INTEGER(out, get_vect(bits, vp, n - 1)); // 64-bit
    else {
        VAL_RESET_HEADER(out, REB_DECIMAL);
        INIT_DECIMAL_BITS(out, get_vect(bits, vp, n - 1)); // 64-bit
    }
}
Пример #21
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;
}
Пример #22
0
Файл: m-gc.c Проект: mbk/ren-c
REBVAL *N_watch(REBFRM *frame, REBVAL **inter_block)
{
	WatchVar = Get_Word(FRM_ARG1(frame));
	Watcher = VAL_SERIES(WatchVar);
	SET_INTEGER(FRM_ARG1(frame), 0);
	return Nothing;
}
Пример #23
0
*/	void Set_Error_Type(ERROR_OBJ *error)
/*
**		Sets error type and id fields based on code number.
**
***********************************************************************/
{
	REBSER *cats;		// Error catalog object
	REBSER *cat;		// Error category object
	REBCNT n;		// Word symbol number
	REBCNT code;

	code = VAL_INT32(&error->code);

	// Set error category:
	n = code / 100 + 1;
	cats = VAL_OBJ_FRAME(Get_System(SYS_CATALOG, CAT_ERRORS));

	if (code >= 0 && n < SERIES_TAIL(cats) &&
		NZ(cat = VAL_SERIES(BLK_SKIP(cats, n)))
	) {
		Set_Word(&error->type, FRM_WORD_SYM(cats, n), cats, n);

		// Find word related to the error itself:
		
		n = code % 100 + 3;
		if (n < SERIES_TAIL(cat))
			Set_Word(&error->id, FRM_WORD_SYM(cat, n), cat, n);
	}
}
Пример #24
0
/***********************************************************************
**
**	Get_Obj_Mods -- return a block of modified words from an object
**
***********************************************************************/
REBVAL *Get_Obj_Mods(REBFRM *frame, REBVAL **inter_block)
{
	REBVAL *obj  = D_ARG(1);
	REBVAL *words, *val;
	REBFRM *frm  = VAL_OBJ_FRAME(obj);
	REBSER *ser  = Make_Block(2);
	REBOOL clear = D_REF(2);
	//DISABLE_GC;

	val   = BLK_HEAD(frm->values);
	words = BLK_HEAD(frm->words);
	for (; NOT_END(val); val++, words++)
		if (!(VAL_FLAGS(val) & FLAGS_CLEAN)) {
			Append_Val(ser, words);
			if (clear) VAL_FLAGS(val) |= FLAGS_CLEAN;
		}
	if (!STR_LEN(ser)) {
		ENABLE_GC;
		goto is_none;
	}

	Bind_Block(frm, BLK_HEAD(ser), FALSE);
	VAL_SERIES(Temp_Blk_Value) = ser;
	//ENABLE_GC;
	return Temp_Blk_Value;
}
Пример #25
0
*/  static void Bind_Relative_Words(REBSER *frame, REBSER *block)
/*
**      Recursive function for relative function word binding.
**
**      Note: frame arg points to an identifying series of the function,
**      not a normal frame. This will be used to verify the word fetch.
**
***********************************************************************/
{
	REBVAL *value = BLK_HEAD(block);
	REBINT n;

	for (; NOT_END(value); value++) {
		if (ANY_WORD(value)) {
			// Is the word (canon sym) found in this frame?
			if (NZ(n = WORDS_HEAD(Bind_Table)[VAL_WORD_CANON(value)])) {
				// Word is in frame, bind it:
				VAL_WORD_INDEX(value) = n;
				VAL_WORD_FRAME(value) = frame; // func body
			}
		}
		else if (ANY_BLOCK(value))
			Bind_Relative_Words(frame, VAL_SERIES(value));
	}
}
Пример #26
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, '>');

}
Пример #27
0
*/	static REBFLG Get_Index_Var(REBVAL *item, REBSER *series, REBINT *index)
/*
**		Get the series index from a word or path or integer.
**
**		Returns: TRUE if value was a series. FALSE if integer.
**
***********************************************************************/
{
	REBVAL *hold = item;

	if (IS_END(item)) Trap1(RE_PARSE_END, item);

	if (IS_WORD(item)) {
		if (!VAL_CMD(item)) item = Get_Var(item);
	}
	else if (IS_PATH(item)) {
		REBVAL *path = item;
		Do_Path(&path, 0); //!!! function!
		item = DS_TOP;
	}
	else if (!IS_INTEGER(item))
		Trap1(RE_PARSE_VARIABLE, hold); 

	if (IS_INTEGER(item)) {
		*index = Int32(item);
		return FALSE;
	}

	if (!ANY_SERIES(item) || VAL_SERIES(item) != series)
		Trap1(RE_PARSE_SERIES, hold);

	*index = VAL_INDEX(item);
	return TRUE;
}
Пример #28
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);
}
Пример #29
0
//
//  Mold_Bitset: C
//
void Mold_Bitset(const REBVAL *value, REB_MOLD *mold)
{
    REBSER *ser = VAL_SERIES(value);

    if (BITS_NOT(ser)) Append_Unencoded(mold->series, "[not bits ");
    Mold_Binary(value, mold);
    if (BITS_NOT(ser)) Append_Codepoint_Raw(mold->series, ']');
}
Пример #30
0
//
//  Temp_Byte_Chars_May_Fail: C
// 
// NOTE: This function returns a temporary result, and uses an internal
// buffer.  Do not use it recursively.  Also, it will Trap on errors.
// 
// Prequalifies a string before using it with a function that
// expects it to be 8-bits.  It would be used for instance to convert
// a string that is potentially REBUNI-wide into a form that can be used
// with a Scan_XXX routine, that is expecting ASCII or UTF-8 source.
// (Many TO-XXX conversions from STRING re-use that scanner logic.)
// 
// Returns a temporary string and sets the length field.
// 
// If `allow_utf8`, the constructed result is converted to UTF8.
// 
// Checks or converts it:
// 
//     1. it is byte string (not unicode)
//     2. if unicode, copy and return as temp byte string
//     3. it's actual content (less space, newlines) <= max len
//     4. it does not contain other values ("123 456")
//     5. it's not empty or only whitespace
//
REBYTE *Temp_Byte_Chars_May_Fail(
    const REBVAL *val,
    REBINT max_len,
    REBCNT *length,
    REBOOL allow_utf8
) {
    REBCNT tail = VAL_LEN_HEAD(val);
    REBCNT index = VAL_INDEX(val);
    REBCNT len;
    REBUNI c;
    REBYTE *bp;
    REBSER *src = VAL_SERIES(val);

    if (index > tail) fail (Error(RE_PAST_END));

    Resize_Series(BYTE_BUF, max_len+1);
    bp = BIN_HEAD(BYTE_BUF);

    // Skip leading whitespace:
    for (; index < tail; index++) {
        c = GET_ANY_CHAR(src, index);
        if (!IS_SPACE(c)) break;
    }

    // Copy chars that are valid:
    for (; index < tail; index++) {
        c = GET_ANY_CHAR(src, index);
        if (c >= 0x80) {
            if (!allow_utf8) fail (Error(RE_INVALID_CHARS));

            len = Encode_UTF8_Char(bp, c);
            max_len -= len;
            bp += len;
        }
        else if (!IS_SPACE(c)) {
            *bp++ = (REBYTE)c;
            max_len--;
        }
        else break;
        if (max_len < 0)
            fail (Error(RE_TOO_LONG));
    }

    // Rest better be just spaces:
    for (; index < tail; index++) {
        c = GET_ANY_CHAR(src, index);
        if (!IS_SPACE(c)) fail (Error(RE_INVALID_CHARS));
    }

    *bp = '\0';

    len = bp - BIN_HEAD(BYTE_BUF);
    if (len == 0) fail (Error(RE_TOO_SHORT));

    if (length) *length = len;

    return BIN_HEAD(BYTE_BUF);
}