C++ VAL_WORD_SYM函数代码示例

*/	REBVAL *Find_Error_Info(ERROR_OBJ *error, REBINT *num)
/*
**		Return the error message needed to print an error.
**		Must scan the error catalog and its error lists.
**		Note that the error type and id words no longer need
**		to be bound to the error catalog context.
**		If the message is not found, return null.
**
***********************************************************************/
{
	REBSER *frame;
	REBVAL *obj1;
	REBVAL *obj2;

	if (!IS_WORD(&error->type) || !IS_WORD(&error->id)) return 0;

	// Find the correct error type object in the catalog:
	frame = VAL_OBJ_FRAME(Get_System(SYS_CATALOG, CAT_ERRORS));
	obj1 = Find_Word_Value(frame, VAL_WORD_SYM(&error->type));
	if (!obj1) return 0;

	// Now find the correct error message for that type:
	frame = VAL_OBJ_FRAME(obj1);
	obj2 = Find_Word_Value(frame, VAL_WORD_SYM(&error->id));
	if (!obj2) return 0;

	if (num) {
		obj1 = Find_Word_Value(frame, SYM_CODE);
		*num = VAL_INT32(obj1)
			+ Find_Word_Index(frame, VAL_WORD_SYM(&error->id), FALSE)
			- Find_Word_Index(frame, SYM_TYPE, FALSE) - 1;
	}

	return obj2;
}

//
//  Find_Key: C
// 
// Returns hash index (either the match or the new one).
// A return of zero is valid (as a hash index);
// 
// Wide: width of record (normally 2, a key and a value).
// 
// Modes:
//     0 - search, return hash if found or not
//     1 - search, return hash, else return -1 if not
//     2 - search, return hash, else append value and return -1
//
REBINT Find_Key(REBSER *series, REBSER *hser, const REBVAL *key, REBINT wide, REBCNT cased, REBYTE mode)
{
    REBCNT *hashes;
    REBCNT skip;
    REBCNT hash;
    REBCNT len;
    REBCNT n;
    REBVAL *val;

    // Compute hash for value:
    len = hser->tail;
    hash = Hash_Value(key, len);
    if (!hash) fail (Error_Has_Bad_Type(key));

    // Determine skip and first index:
    skip  = (len == 0) ? 0 : (hash & 0x0000FFFF) % len;
    if (skip == 0) skip = 1;
    hash = (len == 0) ? 0 : (hash & 0x00FFFF00) % len;

    // Scan hash table for match:
    hashes = (REBCNT*)hser->data;
    if (ANY_WORD(key)) {
        while ((n = hashes[hash])) {
            val = BLK_SKIP(series, (n-1) * wide);
            if (
                ANY_WORD(val) &&
                (VAL_WORD_SYM(key) == VAL_WORD_SYM(val) ||
                (!cased && VAL_WORD_CANON(key) == VAL_WORD_CANON(val)))
            ) return hash;
            hash += skip;
            if (hash >= len) hash -= len;
        }
    }
    else if (ANY_BINSTR(key)) {
        while ((n = hashes[hash])) {
            val = BLK_SKIP(series, (n-1) * wide);
            if (
                VAL_TYPE(val) == VAL_TYPE(key)
                && 0 == Compare_String_Vals(key, val, (REBOOL)(!IS_BINARY(key) && !cased))
            ) return hash;
            hash += skip;
            if (hash >= len) hash -= len;
        }
    } else {
        while ((n = hashes[hash])) {
            val = BLK_SKIP(series, (n-1) * wide);
            if (VAL_TYPE(val) == VAL_TYPE(key) && 0 == Cmp_Value(key, val, !cased)) return hash;
            hash += skip;
            if (hash >= len) hash -= len;
        }
    }

    // Append new value the target series:
    if (mode > 1) {
        hashes[hash] = SERIES_TAIL(series) + 1;
        Append_Values_Len(series, key, wide);
    }

    return (mode > 0) ? NOT_FOUND : hash;
}

*/	REBINT PD_Object(REBPVS *pvs)
/*
***********************************************************************/
{
	REBINT n = 0;

	if (!VAL_OBJ_FRAME(pvs->value)) {
		return PE_NONE; // Error objects may not have a frame.
	}

	if (IS_WORD(pvs->select)) {
		n = Find_Word_Index(VAL_OBJ_FRAME(pvs->value), VAL_WORD_SYM(pvs->select), FALSE);
	}
//	else if (IS_INTEGER(pvs->select)) {
//		n = Int32s(pvs->select, 1);
//	}
	else return PE_BAD_SELECT;

	if (n <= 0 || (REBCNT)n >= SERIES_TAIL(VAL_OBJ_FRAME(pvs->value)))
		return PE_BAD_SELECT;

	if (pvs->setval && IS_END(pvs->path+1) && VAL_PROTECTED(VAL_FRM_WORD(pvs->value, n)))
		Trap1(RE_LOCKED_WORD, pvs->select);

	pvs->value = VAL_OBJ_VALUES(pvs->value) + n;
	return PE_SET;
	// if setval, check PROTECT mode!!!
	// VAL_FLAGS((VAL_OBJ_VALUES(value) + n)) &= ~FLAGS_CLEAN;
}

*/	REBYTE *Get_Word_Name(REBVAL *value)
/*
***********************************************************************/
{
	if (value) return Get_Sym_Name(VAL_WORD_SYM(value));
	return (REBYTE*)"(unnamed)";
}

*/	REBSER *List_Func_Types(REBVAL *func)
/*
**		Return a block of function arg types.
**		Note: skips 0th entry.
**
***********************************************************************/
{
	REBSER *block;
	REBSER *words = VAL_FUNC_WORDS(func);
	REBCNT n;
	REBVAL *value;
	REBVAL *word;

	block = Make_Block(SERIES_TAIL(words));
	word = BLK_SKIP(words, 1);

	for (n = 1; n < SERIES_TAIL(words); word++, n++) {
		value = Alloc_Tail_Blk(block);
		VAL_SET(value, VAL_TYPE(word));
		VAL_WORD_SYM(value) = VAL_BIND_SYM(word);
		UNBIND(value);
	}

	return block;
}

//
//  Resolve_Path: C
//
// Given a path, return a context and index for its terminal.
//
REBCTX *Resolve_Path(REBVAL *path, REBCNT *index)
{
    REBVAL *sel; // selector
    const REBVAL *val;
    REBARR *blk;
    REBCNT i;

    if (VAL_LEN_HEAD(path) < 2) return 0;
    blk = VAL_ARRAY(path);
    sel = ARR_HEAD(blk);
    if (!ANY_WORD(sel)) return 0;
    val = GET_OPT_VAR_MAY_FAIL(sel);

    sel = ARR_AT(blk, 1);
    while (TRUE) {
        if (!ANY_CONTEXT(val) || !IS_WORD(sel)) return 0;
        i = Find_Word_In_Context(VAL_CONTEXT(val), VAL_WORD_SYM(sel), FALSE);
        sel++;
        if (IS_END(sel)) {
            *index = i;
            return VAL_CONTEXT(val);
        }
    }

    return 0; // never happens
}

STOID Form_Block_Series(REBSER *blk, REBCNT index, REB_MOLD *mold, REBSER *frame)
{
	// Form a series (part_mold means mold non-string values):
	REBINT n;
	REBINT len = SERIES_TAIL(blk) - index;
	REBVAL *val;
	REBVAL *wval;

	if (len < 0) len = 0;

	for (n = 0; n < len;) {
		val = BLK_SKIP(blk, index+n);
		wval = 0;
		if (frame && (IS_WORD(val) || IS_GET_WORD(val))) {
			wval = Find_Word_Value(frame, VAL_WORD_SYM(val));
			if (wval) val = wval;
		}
		Mold_Value(mold, val, wval != 0);
		n++;
		if (GET_MOPT(mold, MOPT_LINES)) {
			Append_Byte(mold->series, LF);
		}
		else {
			// Add a space if needed:
			if (n < len && mold->series->tail
				&& *UNI_LAST(mold->series) != LF
				&& !GET_MOPT(mold, MOPT_TIGHT)
			)
				Append_Byte(mold->series, ' ');
		}
	}
}

xx*/	void Dump_Word_Value(REBVAL *word)
/*
***********************************************************************/
{
	Debug_Fmt("Word: %s (Symbol %d Frame %x Index %d)", Get_Word_Name(word),
		VAL_WORD_SYM(word), VAL_WORD_FRAME(word), VAL_WORD_INDEX(word));
}

*/  REBVAL *Append_Frame(REBSER *frame, REBVAL *word, REBCNT sym)
/*
**      Append a word to the frame word list. Expands the list
**      if necessary. Returns the value cell for the word. (Set to
**      UNSET by default to avoid GC corruption.)
**
**      If word is not NULL, use the word sym and bind the word value,
**      otherwise use sym.
**
***********************************************************************/
{
	REBSER *words = FRM_WORD_SERIES(frame);
	REBVAL *value;

	// Add to word list:
	EXPAND_SERIES_TAIL(words, 1);
	value = BLK_LAST(words);
	Val_Init_Word_Typed(value, REB_WORD, word ? VAL_WORD_SYM(word) : sym, ALL_64);
	BLK_TERM(words);

	// Bind the word to this frame:
	if (word) {
		VAL_WORD_FRAME(word) = frame;
		VAL_WORD_INDEX(word) = frame->tail;
	}

	// Add unset value to frame:
	EXPAND_SERIES_TAIL(frame, 1);
	word = BLK_LAST(frame);
	SET_UNSET(word);
	BLK_TERM(frame);

	return word; // The value cell for word.
}

*/	REBINT PD_Frame(REBPVS *pvs)
/*
**		pvs->value points to the first value in frame (SELF).
**
***********************************************************************/
{
	REBCNT sym;
	REBCNT s;
	REBVAL *word;
	REBVAL *val;

	if (IS_WORD(pvs->select)) {
		sym = VAL_WORD_SYM(pvs->select);
		s = SYMBOL_TO_CANON(sym);
		word = BLK_SKIP(VAL_FRM_WORDS(pvs->value), 1);
		for (val = pvs->value + 1; NOT_END(val); val++, word++) {
			if (sym == VAL_BIND_SYM(word) || s == VAL_BIND_CANON(word)) {
				if (VAL_GET_OPT(word, OPTS_HIDE)) break;
				if (VAL_PROTECTED(word)) Trap1(RE_LOCKED_WORD, word);
				pvs->value = val;
				return PE_SET;
			}
		}
	}
	return PE_BAD_SELECT;
}

*/	void Set_Word(REBVAL *value, REBINT sym, REBSER *frame, REBCNT index)
/*
***********************************************************************/
{
	VAL_SET(value, REB_WORD);
	VAL_WORD_SYM(value) = sym;
	VAL_WORD_FRAME(value) = frame;
	VAL_WORD_INDEX(value) = index;
}

//
//  PD_Pair: C
//
REBINT PD_Pair(REBPVS *pvs)
{
    const REBVAL *sel = pvs->selector;
    REBINT n = 0;
    REBDEC dec;

    if (IS_WORD(sel)) {
        if (VAL_WORD_SYM(sel) == SYM_X)
            n = 1;
        else if (VAL_WORD_SYM(sel) == SYM_Y)
            n = 2;
        else
            fail (Error_Bad_Path_Select(pvs));
    }
    else if (IS_INTEGER(sel)) {
        n = Int32(sel);
        if (n != 1 && n != 2)
            fail (Error_Bad_Path_Select(pvs));
    }
    else fail (Error_Bad_Path_Select(pvs));

    if (pvs->opt_setval) {
        const REBVAL *setval = pvs->opt_setval;

        if (IS_INTEGER(setval))
            dec = cast(REBDEC, VAL_INT64(setval));
        else if (IS_DECIMAL(setval))
            dec = VAL_DECIMAL(setval);
        else
            fail (Error_Bad_Path_Set(pvs));

        if (n == 1)
            VAL_PAIR_X(pvs->value) = dec;
        else
            VAL_PAIR_Y(pvs->value) = dec;
    }
    else {
        dec = (n == 1 ? VAL_PAIR_X(pvs->value) : VAL_PAIR_Y(pvs->value));
        SET_DECIMAL(pvs->store, dec);
        return PE_USE_STORE;
    }

    return PE_OK;
}

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

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

//
//  CT_Word: C
//
REBINT CT_Word(REBVAL *a, REBVAL *b, REBINT mode)
{
    REBINT e;
    REBINT diff;
    if (mode >= 0) {
        e = VAL_WORD_CANON(a) == VAL_WORD_CANON(b);
        if (mode == 1) e &= VAL_WORD_INDEX(a) == VAL_WORD_INDEX(b)
            && VAL_WORD_FRAME(a) == VAL_WORD_FRAME(b);
        else if (mode >= 2) {
            e = (VAL_WORD_SYM(a) == VAL_WORD_SYM(b) &&
                VAL_WORD_INDEX(a) == VAL_WORD_INDEX(b) &&
                VAL_WORD_FRAME(a) == VAL_WORD_FRAME(b));
        }
    } else {
        diff = Compare_Word(a, b, FALSE);
        if (mode == -1) e = diff >= 0;
        else e = diff > 0;
    }
    return e;
}