Exemple #1
0
//
//  Map_To_Block: C
// 
// mapser = series of the map
// what: -1 - words, +1 - values, 0 -both
//
REBSER *Map_To_Block(REBSER *mapser, REBINT what)
{
    REBVAL *val;
    REBCNT cnt = 0;
    REBSER *blk;
    REBVAL *out;

    // Count number of set entries:
    for (val = BLK_HEAD(mapser); NOT_END(val) && NOT_END(val+1); val += 2) {
        if (!IS_NONE(val+1)) cnt++; // must have non-none value
    }

    // Copy entries to new block:
    blk = Make_Array(cnt * ((what == 0) ? 2 : 1));
    out = BLK_HEAD(blk);
    for (val = BLK_HEAD(mapser); NOT_END(val) && NOT_END(val+1); val += 2) {
        if (!IS_NONE(val+1)) {
            if (what <= 0) *out++ = val[0];
            if (what >= 0) *out++ = val[1];
        }
    }

    SET_END(out);
    blk->tail = out - BLK_HEAD(blk);
    return blk;
}
Exemple #2
0
//
//  Copy_And_Bind_Relative_Deep_Managed: C
//
// This routine is called by Make_Function in order to take the raw material
// given as a function body, and de-relativize any IS_RELATIVE(value)s that
// happen to be in it already (as any Copy does).  But it also needs to make
// new relative references to ANY-WORD! that are referencing function
// parameters, as well as to relativize the copies of ANY-ARRAY! that contain
// these relative words...so that they refer to the archetypal function
// to which they should be relative.
//
REBARR *Copy_And_Bind_Relative_Deep_Managed(
    const REBVAL *body,
    REBARR *paramlist, // body of function is not actually ready yet
    REBU64 bind_types
) {
    // !!! Currently this is done in two phases, because the historical code
    // would use the generic copying code and then do a bind phase afterward.
    // Both phases are folded into this routine to make it easier to make
    // a one-pass version when time permits.
    //
    REBARR *copy = COPY_ANY_ARRAY_AT_DEEP_MANAGED(body);

    struct Reb_Binder binder;
    INIT_BINDER(&binder);

    // Setup binding table from the argument word list
    //
    REBCNT index = 1;
    RELVAL *param = ARR_AT(paramlist, 1); // [0] is FUNCTION! value
    for (; NOT_END(param); param++, index++)
        Add_Binder_Index(&binder, VAL_KEY_CANON(param), index);

    Bind_Relative_Inner_Loop(&binder, ARR_HEAD(copy), paramlist, bind_types);

    // Reset binding table
    //
    param = ARR_AT(paramlist, 1); // [0] is FUNCTION! value
    for (; NOT_END(param); param++)
        Remove_Binder_Index(&binder, VAL_KEY_CANON(param));

    SHUTDOWN_BINDER(&binder);
    return copy;
}
Exemple #3
0
*/  void Bind_Relative(REBSER *words, REBSER *frame, REBSER *block)
/*
**      Bind the words of a function block to a stack frame.
**      To indicate the relative nature of the index, it is set to
**		a negative offset.
**
**		words: VAL_FUNC_ARGS(func)
**		frame: VAL_FUNC_ARGS(func)
**		block: block to bind
**
***********************************************************************/
{
	REBVAL *args;
	REBINT index;
	REBINT *binds = WORDS_HEAD(Bind_Table); // GC safe to do here

	args = BLK_SKIP(words, 1);

	CHECK_BIND_TABLE;

	//Dump_Block(words);

	// Setup binding table from the argument word list:
	for (index = 1; NOT_END(args); args++, index++)
		binds[VAL_BIND_CANON(args)] = -index;

	Bind_Relative_Words(frame, block);

	// Reset binding table:
	for (args = BLK_SKIP(words, 1); NOT_END(args); args++)
		binds[VAL_BIND_CANON(args)] = 0;
}
Exemple #4
0
static REBSER *Trim_Object(REBSER *obj)
{
	REBVAL *val;
	REBINT cnt = 0;
	REBSER *nobj;
	REBVAL *nval;
	REBVAL *word;
	REBVAL *nwrd;

	word = FRM_WORDS(obj)+1;
	for (val = FRM_VALUES(obj)+1; NOT_END(val); val++, word++) {
		if (VAL_TYPE(val) > REB_NONE && !VAL_GET_OPT(word, OPTS_HIDE))
			cnt++;
	}

	nobj = Make_Frame(cnt);
	nval = FRM_VALUES(nobj)+1;
	word = FRM_WORDS(obj)+1;
	nwrd = FRM_WORDS(nobj)+1;
	for (val = FRM_VALUES(obj)+1; NOT_END(val); val++, word++) {
		if (VAL_TYPE(val) > REB_NONE && !VAL_GET_OPT(word, OPTS_HIDE)) {
			*nval++ = *val;
			*nwrd++ = *word;
		}
	}
	SET_END(nval);
	SET_END(nwrd);
	SERIES_TAIL(nobj) = cnt+1;
	SERIES_TAIL(FRM_WORD_SERIES(nobj)) = cnt+1;

	return nobj;
}
Exemple #5
0
//
//  Append_Map: C
//
static void Append_Map(REBSER *ser, REBVAL *arg, REBCNT len)
{
    REBVAL *val;
    REBCNT n;

    val = VAL_BLK_DATA(arg);
    for (n = 0; n < len && NOT_END(val) && NOT_END(val+1); val += 2, n += 2) {
        Find_Entry(ser, val, val+1);
    }
}
Exemple #6
0
STOID Mold_Block_Series(REB_MOLD *mold, REBSER *series, REBCNT index, REBYTE *sep)
{
	REBSER *out = mold->series;
	REBOOL line_flag = FALSE; // newline was part of block
	REBOOL had_lines = FALSE;
	REBVAL *value = BLK_SKIP(series, index);

	if (!sep) sep = "[]";

	if (IS_END(value)) {
		Append_Bytes(out, sep);
		return;
	}

	// Recursion check: (variation of: Find_Same_Block(MOLD_LOOP, value))
	for (value = BLK_HEAD(MOLD_LOOP); NOT_END(value); value++) {
		if (VAL_SERIES(value) == series) {
			Emit(mold, "C...C", sep[0], sep[1]);
			return;
		}
	}
	value = Append_Value(MOLD_LOOP);
	Set_Block(value, series);

	if (sep[1]) {
		Append_Byte(out, sep[0]);
		mold->indent++;
	}
//	else out->tail--;  // why?????

	value = BLK_SKIP(series, index);
	while (NOT_END(value)) {
		if (VAL_GET_LINE(value)) {
			if (sep[1] || line_flag) New_Indented_Line(mold);
			had_lines = TRUE;
		}
		line_flag = TRUE;
		Mold_Value(mold, value, TRUE);
		value++;
		if (NOT_END(value))
			Append_Byte(out, (sep[0] == '/') ? '/' : ' ');
	}

	if (sep[1]) {
		mold->indent--;
		if (VAL_GET_LINE(value) || had_lines) New_Indented_Line(mold);
		Append_Byte(out, sep[1]);
	}

	Remove_Last(MOLD_LOOP);
}
Exemple #7
0
//
//  Bind_Values_Core: C
//
// Bind words in an array of values terminated with END
// to a specified context.  See warnings on the functions like
// Bind_Values_Deep() about not passing just a singular REBVAL.
//
// NOTE: If types are added, then they will be added in "midstream".  Only
// bindings that come after the added value is seen will be bound.
//
void Bind_Values_Core(
    RELVAL *head,
    REBCTX *context,
    REBU64 bind_types,
    REBU64 add_midstream_types,
    REBFLGS flags // see %sys-core.h for BIND_DEEP, etc.
) {
    struct Reb_Binder binder;
    INIT_BINDER(&binder);

    // Via the global hash table, each spelling of the word can find the
    // canon form of the word.  Associate that with an index number to signal
    // a binding should be created to this context (at that index.)

    REBCNT index = 1;
    REBVAL *key = CTX_KEYS_HEAD(context);
    for (; index <= CTX_LEN(context); key++, index++)
        if (!GET_VAL_FLAG(key, TYPESET_FLAG_UNBINDABLE))
            Add_Binder_Index(&binder, VAL_KEY_CANON(key), index);

    Bind_Values_Inner_Loop(
        &binder, head, context, bind_types, add_midstream_types, flags
    );

    // Reset all the binder indices to zero, balancing out what was added.

    key = CTX_KEYS_HEAD(context);
    for (; NOT_END(key); key++)
        Remove_Binder_Index(&binder, VAL_KEY_CANON(key));

    SHUTDOWN_BINDER(&binder);
}
Exemple #8
0
*/ RL_API u32 *RL_Map_Words(REBSER *series)
/*
**	Given a block of word values, return an array of word ids.
**
**	Returns:
**		An array of global word identifiers (integers). The [0] value is the size.
**	Arguments:
**		series - block of words as values (from REBOL blocks, not strings.)
**	Notes:
**		Word identifiers are persistent, and you can use them anytime.
**		The block can include any kind of word, including set-words, lit-words, etc.
**		If the input block contains non-words, they will be skipped.
**		The array is allocated with OS_ALLOC and you can OS_FREE it any time.
**
***********************************************************************/
{
	REBCNT i = 1;
	u32 *words;
	REBVAL *val = BLK_HEAD(series);

	words = OS_ALLOC_ARRAY(u32, series->tail + 2);

	for (; NOT_END(val); val++) {
		if (ANY_WORD(val)) words[i++] = VAL_WORD_CANON(val);
	}

	words[0] = i;
	words[i] = 0;

	return words;
}
Exemple #9
0
//
//  RL_Words_Of_Object: C
// 
// Returns information about the object.
// 
// Returns:
//     Returns an array of words used as fields of the object.
// Arguments:
//     obj  - object pointer (e.g. from RXA_OBJECT)
// Notes:
//     Returns a word array similar to MAP_WORDS().
//     The array is allocated with OS_ALLOC. You can OS_FREE it any time.
//
RL_API u32 *RL_Words_Of_Object(REBSER *obj)
{
    REBCNT index;
    u32 *syms;
    REBVAL *key;
    REBCTX *context = AS_CONTEXT(obj);

    key = CTX_KEYS_HEAD(context);

    // We don't include hidden keys (e.g. SELF), but terminate by 0.
    // Conservative estimate that there are no hidden keys, add one.
    //
    syms = OS_ALLOC_N(u32, CTX_LEN(context) + 1);

    index = 0;
    for (; NOT_END(key); key++) {
        if (GET_VAL_FLAG(key, TYPESET_FLAG_HIDDEN))
            continue;

        syms[index] = VAL_TYPESET_CANON(key);
        index++;
    }

    syms[index] = SYM_0; // Null terminate

    return syms;
}
Exemple #10
0
*/  REBSER *Collect_Words(REBVAL value[], REBVAL prior_value[], REBCNT modes)
/*
**		Collect words from a prior block and new block.
**
***********************************************************************/
{
	REBSER *series;
	REBCNT start;
	REBINT *binds = WORDS_HEAD(Bind_Table); // GC safe to do here
	CHECK_BIND_TABLE;

	if (SERIES_TAIL(BUF_WORDS)) panic Error_0(RE_WORD_LIST); // still in use

	if (prior_value)
		Collect_Words_Inner_Loop(binds, &prior_value[0], BIND_ALL);

	start = SERIES_TAIL(BUF_WORDS);
	Collect_Words_Inner_Loop(binds, &value[0], modes);

	// Reset word markers:
	for (value = BLK_HEAD(BUF_WORDS); NOT_END(value); value++)
		binds[VAL_WORD_CANON(value)] = 0;

	series = Copy_Array_At_Max_Shallow(
		BUF_WORDS, start, SERIES_TAIL(BUF_WORDS) - start
	);
	RESET_TAIL(BUF_WORDS);  // allow reuse

	CHECK_BIND_TABLE;
	return series;
}
Exemple #11
0
*/	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;
}
Exemple #12
0
//
//  Is_Type_Of: C
// 
// Types can be: word or block. Each element must be either
// a datatype or a typeset.
//
static REBOOL Is_Type_Of(const REBVAL *value, REBVAL *types)
{
    const REBVAL *val;

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

    if (IS_DATATYPE(val))
        return LOGICAL(VAL_TYPE_KIND(val) == VAL_TYPE(value));

    if (IS_TYPESET(val))
        return LOGICAL(TYPE_CHECK(val, VAL_TYPE(value)));

    if (IS_BLOCK(val)) {
        for (types = VAL_ARRAY_AT(val); NOT_END(types); types++) {
            val = IS_WORD(types) ? GET_OPT_VAR_MAY_FAIL(types) : types;
            if (IS_DATATYPE(val)) {
                if (VAL_TYPE_KIND(val) == VAL_TYPE(value)) return TRUE;
            }
            else if (IS_TYPESET(val)) {
                if (TYPE_CHECK(val, VAL_TYPE(value))) return TRUE;
            }
            else
                fail (Error(RE_INVALID_TYPE, Type_Of(val)));
        }
        return FALSE;
    }

    fail (Error_Invalid_Arg(types));
}
Exemple #13
0
*/  REBSER *Merge_Frames(REBSER *parent1, REBSER *parent2)
/*
**      Create a child frame from two parent frames. Merge common fields.
**      Values from the second parent take precedence.
**
**		Deep copy and rebind the child.
**
***********************************************************************/
{
	REBSER *wrds;
	REBSER *child;
	REBVAL *words;
	REBVAL *value;
	REBCNT n;
	REBINT *binds = WORDS_HEAD(Bind_Table);

	// Merge parent1 and parent2 words.
	// Keep the binding table.
	Collect_Start(BIND_ALL);
	// Setup binding table and BUF_WORDS with parent1 words:
	if (parent1) Collect_Object(parent1);
	// Add parent2 words to binding table and BUF_WORDS:
	Collect_Words(BLK_SKIP(FRM_WORD_SERIES(parent2), 1), BIND_ALL);

	// Allocate child (now that we know the correct size):
	wrds = Copy_Series(BUF_WORDS);
	child = Make_Block(SERIES_TAIL(wrds));
	value = Append_Value(child);
	VAL_SET(value, REB_FRAME);
	VAL_FRM_WORDS(value) = wrds;
	VAL_FRM_SPEC(value) = 0;

	// Copy parent1 values:
	COPY_VALUES(FRM_VALUES(parent1)+1, FRM_VALUES(child)+1, SERIES_TAIL(parent1)-1);

	// Copy parent2 values:
	words = FRM_WORDS(parent2)+1;
	value = FRM_VALUES(parent2)+1;
	for (; NOT_END(words); words++, value++) {
		// no need to search when the binding table is available
		n = binds[VAL_WORD_CANON(words)];
		BLK_HEAD(child)[n] = *value;
	}

	// Terminate the child frame:
	SERIES_TAIL(child) = SERIES_TAIL(wrds);
	BLK_TERM(child);

	// Deep copy the child
	Copy_Deep_Values(child, 1, SERIES_TAIL(child), TS_CLONE);

	// Rebind the child
	Rebind_Block(parent1, child, BLK_SKIP(child, 1), REBIND_FUNC);
	Rebind_Block(parent2, child, BLK_SKIP(child, 1), REBIND_FUNC | REBIND_TABLE);

	// release the bind table 
	Collect_End(wrds);

	return child;
}
Exemple #14
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));
	}
}
Exemple #15
0
*/  REBSER *Collect_Block_Words(REBVAL *block, REBVAL *prior, REBCNT modes)
/*
**		Collect words from a prior block and new block.
**
***********************************************************************/
{
	REBSER *series;
	REBCNT start;
	REBINT *binds = WORDS_HEAD(Bind_Table); // GC safe to do here
	CHECK_BIND_TABLE;

	if (SERIES_TAIL(BUF_WORDS)) Crash(RP_WORD_LIST); // still in use

	if (prior)
		Collect_Simple_Words(prior, BIND_ALL);

	start = SERIES_TAIL(BUF_WORDS);
	Collect_Simple_Words(block, modes);

	// Reset word markers:
	for (block = BLK_HEAD(BUF_WORDS); NOT_END(block); block++)
		binds[VAL_WORD_CANON(block)] = 0;

	series = Copy_Series_Part(BUF_WORDS, start, SERIES_TAIL(BUF_WORDS)-start);
	RESET_TAIL(BUF_WORDS);  // allow reuse

	CHECK_BIND_TABLE;
	return series;
}
Exemple #16
0
*/	REBFLG MT_Tuple(REBVAL *out, REBVAL *data, REBCNT type)
/*
***********************************************************************/
{
	REBYTE	*vp;
	REBINT len = 0;
	REBINT n;

	vp = VAL_TUPLE(out);
	for (; NOT_END(data); data++, vp++, len++) {
		if (len >= 10) return FALSE;
		if (IS_INTEGER(data)) {
			n = Int32(data);
		}
		else if (IS_CHAR(data)) {
			n = VAL_CHAR(data);
		}
		else return FALSE;
		if (n > 255 || n < 0) return FALSE;
		*vp = n;
	}

	VAL_TUPLE_LEN(out) = len;

	for (; len < 10; len++) *vp++ = 0;

	VAL_SET(out, type);
	return TRUE;
}
Exemple #17
0
*/  REBVAL *Find_In_Contexts(REBCNT sym, REBVAL *where)
/*
**      Search a block of objects for a given word symbol and
**      return the value for the word. NULL if not found.
**
***********************************************************************/
{
	REBVAL *val;

	for (; NOT_END(where); where++) {
		if (IS_WORD(where)) {
			val = Get_Var(where);
		}
		else if (IS_PATH(where)) {
			Do_Path(&where, 0);
			val = DS_TOP; // only safe for short time!
		}
		else
			val = where;

		if (IS_OBJECT(val)) {
			val = Find_Word_Value(VAL_OBJ_FRAME(val), sym);
			if (val) return val;
		}
	}
	return 0;
}
Exemple #18
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;
}
Exemple #19
0
*/	void Init_Errors(REBVAL *errors)
/*
***********************************************************************/
{
	REBSER *errs;
	REBVAL *val;

	// Create error objects and error type objects:
	*ROOT_ERROBJ = *Get_System(SYS_STANDARD, STD_ERROR);
	errs = Construct_Object(0, VAL_BLK(errors), 0);
	Set_Object(Get_System(SYS_CATALOG, CAT_ERRORS), errs);

	Set_Root_Series(TASK_ERR_TEMPS, Make_Block(3));

	// Create objects for all error types:
	for (val = BLK_SKIP(errs, 1); NOT_END(val); val++) {
		errs = Construct_Object(0, VAL_BLK(val), 0);
		SET_OBJECT(val, errs);
	}

	// Catch top level errors, to provide decent output:
	PUSH_STATE(Top_State, Saved_State);
	if (SET_JUMP(Top_State)) {
		POP_STATE(Top_State, Saved_State);
		DSP++; // Room for return value
		Catch_Error(DS_TOP); // Stores error value here
		Print_Value(DS_TOP, 0, FALSE);
		Crash(RP_NO_CATCH);
	}
	SET_STATE(Top_State, Saved_State);
}
Exemple #20
0
*/  REBSER *Collect_End(REBSER *prior)
/*
**		Finish collecting words, and free the Bind_Table for reuse.
**
***********************************************************************/
{
	REBVAL *words;
	REBINT *binds = WORDS_HEAD(Bind_Table); // GC safe to do here

	// Reset binding table (note BUF_WORDS may have expanded):
	for (words = BLK_HEAD(BUF_WORDS); NOT_END(words); words++)
		binds[VAL_WORD_CANON(words)] = 0;

	// If no new words, prior frame:
	if (prior && SERIES_TAIL(BUF_WORDS) == SERIES_TAIL(prior)) {
		RESET_TAIL(BUF_WORDS);  // allow reuse
		return FRM_WORD_SERIES(prior);
	}

	prior = Copy_Series(BUF_WORDS);
	RESET_TAIL(BUF_WORDS);  // allow reuse
	BARE_SERIES(prior); // No GC ever needed for word list

	CHECK_BIND_TABLE;

	return prior;
}
Exemple #21
0
//
//  Next_Path_Throws: C
//
// Evaluate next part of a path.
//
REBOOL Next_Path_Throws(REBPVS *pvs)
{
    REBPEF dispatcher;

    REBVAL temp;
    VAL_INIT_WRITABLE_DEBUG(&temp);

    // Path must have dispatcher, else return:
    dispatcher = Path_Dispatch[VAL_TYPE_0(pvs->value)];
    if (!dispatcher) return FALSE; // unwind, then check for errors

    pvs->item++;

    //Debug_Fmt("Next_Path: %r/%r", pvs->path-1, pvs->path);

    // object/:field case:
    if (IS_GET_WORD(pvs->item)) {
        pvs->selector = GET_MUTABLE_VAR_MAY_FAIL(pvs->item);
        if (IS_UNSET(pvs->selector))
            fail (Error(RE_NO_VALUE, pvs->item));
    }
    // object/(expr) case:
    else if (IS_GROUP(pvs->item)) {
        if (DO_VAL_ARRAY_AT_THROWS(&temp, pvs->item)) {
            *pvs->value = temp;
            return TRUE;
        }

        pvs->selector = &temp;
    }
    else // object/word and object/value case:
        pvs->selector = pvs->item;

    switch (dispatcher(pvs)) {
    case PE_OK:
        break;

    case PE_SET_IF_END:
        if (pvs->opt_setval && IS_END(pvs->item + 1)) {
            *pvs->value = *pvs->opt_setval;
            pvs->opt_setval = NULL;
        }
        break;

    case PE_NONE:
        SET_NONE(pvs->store);
    case PE_USE_STORE:
        pvs->value = pvs->store;
        break;

    default:
        assert(FALSE);
    }

    if (NOT_END(pvs->item + 1)) return Next_Path_Throws(pvs);

    return FALSE;
}
Exemple #22
0
//
//  Find_Max_Bit: C
// 
// Return integer number for the maximum bit number defined by
// the value. Used to determine how much space to allocate.
//
REBINT Find_Max_Bit(REBVAL *val)
{
    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 < cast(REBINT, VAL_LEN_HEAD(val)); n++)
                if (bp[n] > maxi) maxi = bp[n];
        }
        else {
            REBUNI *up = VAL_UNI(val);
            for (; n < cast(REBINT, VAL_LEN_HEAD(val)); n++)
                if (up[n] > maxi) maxi = up[n];
        }
        maxi++;
        break;

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

    case REB_BLOCK:
        for (val = VAL_ARRAY_AT(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;
}
Exemple #23
0
*/ void Collect_Words(REBVAL *block, REBFLG modes)
/*
**		The inner recursive loop used for Collect_Words function below.
**
***********************************************************************/
{
	REBINT *binds = WORDS_HEAD(Bind_Table);
	REBVAL *word;
	REBVAL *value;

	for (; NOT_END(block); block++) {
		value = block;
		//if (modes & BIND_GET && IS_GET_WORD(block)) value = Get_Var(block);
		if (ANY_WORD(value)) {
			if (!binds[VAL_WORD_CANON(value)]) {  // only once per word
				if (IS_SET_WORD(value) || modes & BIND_ALL) {
					binds[VAL_WORD_CANON(value)] = SERIES_TAIL(BUF_WORDS);
					EXPAND_SERIES_TAIL(BUF_WORDS, 1);
					word = BLK_LAST(BUF_WORDS);
					VAL_SET(word, VAL_TYPE(value));
					VAL_SET_OPT(word, OPTS_UNWORD);
					VAL_BIND_SYM(word) = VAL_WORD_SYM(value);
					// Allow all datatypes (to start):
					VAL_BIND_TYPESET(word) = ~((TYPESET(REB_END) | TYPESET(REB_UNSET))); // not END or UNSET
				}
			} else {
				// If word duplicated:
				if (modes & BIND_NO_DUP) {
					// Reset binding table (note BUF_WORDS may have expanded):
					for (word = BLK_HEAD(BUF_WORDS); NOT_END(word); word++)
						binds[VAL_WORD_CANON(word)] = 0;
					RESET_TAIL(BUF_WORDS);  // allow reuse
					Trap1(RE_DUP_VARS, value);
				}
			}
			continue;
		}
		// Recurse into sub-blocks:
		if (ANY_EVAL_BLOCK(value) && (modes & BIND_DEEP))
			Collect_Words(VAL_BLK_DATA(value), modes);
		// In this mode (foreach native), do not allow non-words:
		//else if (modes & BIND_GET) Trap_Arg(value);
	}
	BLK_TERM(BUF_WORDS);
}
Exemple #24
0
*/	void Assert_Public_Object(REBVAL *value)
/*
***********************************************************************/
{
	REBVAL *word  = BLK_HEAD(VAL_OBJ_WORDS(value));

	for (; NOT_END(word); word++) 
		if (VAL_GET_OPT(word, OPTS_HIDE)) Trap0(RE_HIDDEN);
}
Exemple #25
0
*/  void Check_Frame(REBSER *frame)
/*
***********************************************************************/
{
	REBINT n;
	REBVAL *values = FRM_VALUES(frame);
	REBVAL *words  = FRM_WORDS(frame);
	REBINT tail = SERIES_TAIL(frame);

	for (n = 0; n < tail; n++, values++, words++) {
		if (IS_END(words) || IS_END(values)) {
			Debug_Fmt("** Early %s end at index: %d", IS_END(words) ? "words" : "values", n);
		}
	}

	if (NOT_END(words) || NOT_END(values))
		Debug_Fmt("** Missing %s end at index: %d type: %d", NOT_END(words) ? "words" : "values", n, VAL_TYPE(words));
}
Exemple #26
0
*/	void Assert_Public_Object(const REBVAL *value)
/*
***********************************************************************/
{
	REBVAL *word  = BLK_HEAD(VAL_OBJ_WORDS(value));

	for (; NOT_END(word); word++)
		if (VAL_GET_EXT(word, EXT_WORD_HIDE)) raise Error_0(RE_HIDDEN);
}
Exemple #27
0
*/ static void Collect_Frame_Inner_Loop(REBINT *binds, REBVAL value[], REBCNT modes)
/*
**		The inner recursive loop used for Collect_Frame function below.
**
***********************************************************************/
{
	for (; NOT_END(value); value++) {
		if (ANY_WORD(value)) {
			if (!binds[VAL_WORD_CANON(value)]) {  // only once per word
				if (IS_SET_WORD(value) || modes & BIND_ALL) {
					REBVAL *word;
					binds[VAL_WORD_CANON(value)] = SERIES_TAIL(BUF_WORDS);
					EXPAND_SERIES_TAIL(BUF_WORDS, 1);
					word = BLK_LAST(BUF_WORDS);
					Val_Init_Word_Typed(
						word,
						VAL_TYPE(value),
						VAL_WORD_SYM(value),
						// Allow all datatypes but END or UNSET (initially):
						~((TYPESET(REB_END) | TYPESET(REB_UNSET)))
					);
				}
			} else {
				// If word duplicated:
				if (modes & BIND_NO_DUP) {
					// Reset binding table (note BUF_WORDS may have expanded):
					REBVAL *word;
					for (word = BLK_HEAD(BUF_WORDS); NOT_END(word); word++)
						binds[VAL_WORD_CANON(word)] = 0;
					RESET_TAIL(BUF_WORDS);  // allow reuse
					raise Error_1(RE_DUP_VARS, value);
				}
			}
			continue;
		}
		// Recurse into sub-blocks:
		if (ANY_EVAL_BLOCK(value) && (modes & BIND_DEEP))
			Collect_Frame_Inner_Loop(binds, VAL_BLK_DATA(value), modes);
		// In this mode (foreach native), do not allow non-words:
		//else if (modes & BIND_GET) raise Error_Invalid_Arg(value);
	}
	BLK_TERM(BUF_WORDS);
}
Exemple #28
0
STOID Mold_Simple_Block(REB_MOLD *mold, REBVAL *block, REBCNT len)
{
	// Simple molder for error locations. Series must be valid.
	// Max length in chars must be provided.
	REBCNT start = SERIES_TAIL(mold->series);

	while (NOT_END(block)) {
		if ((SERIES_TAIL(mold->series) - start) > len) break;
		Mold_Value(mold, block, TRUE);
		block++;
		if (NOT_END(block)) Append_Byte(mold->series, ' ');
	}

	// If it's too large, truncate it:
	if ((SERIES_TAIL(mold->series) - start) > len) {
		SERIES_TAIL(mold->series) = start + len;
		Append_Bytes(mold->series, "...");
	}
}
Exemple #29
0
*/	static int Count_Dia_Args(REBVAL *args)
/*
**		Return number of formal args provided to the function.
**		This is just a guess, because * repeats count as zero.
**
***********************************************************************/
{
	REBINT n = 0;

	for (; NOT_END(args); args++) {
		if (IS_WORD(args)) {
			if (VAL_WORD_SYM(args) == SYM__P) { // skip: * type
				if (NOT_END(args+1)) args++;
			} else n++;
		}
		else if (IS_DATATYPE(args) || IS_TYPESET(args)) n++;
	}
	return n;
}
Exemple #30
0
*/	REBSER *Map_To_Object(REBSER *mapser)
/*
***********************************************************************/
{
	REBVAL *val;
	REBCNT cnt = 0;
	REBSER *frame;
	REBVAL *key;
	REBVAL *mval;

	// Count number of set entries:
	for (mval = BLK_HEAD(mapser); NOT_END(mval) && NOT_END(mval+1); mval += 2) {
		if (ANY_WORD(mval) && !IS_NONE(mval+1)) cnt++;
	}

	// See Make_Frame() - cannot use it directly because no Collect_Words
	frame = Make_Frame(cnt, TRUE);

	key = FRM_KEY(frame, 1);
	val  = FRM_VALUE(frame, 1);
	for (mval = BLK_HEAD(mapser); NOT_END(mval) && NOT_END(mval+1); mval += 2) {
		if (ANY_WORD(mval) && !IS_NONE(mval+1)) {
			// !!! Used to leave SET_WORD typed values here... but why?
			// (Objects did not make use of the set-word vs. other distinctions
			// that function specs did.)
			Val_Init_Typeset(
				key,
				// all types except END or UNSET
				~((FLAGIT_64(REB_END) | FLAGIT_64(REB_UNSET))),
				VAL_WORD_SYM(mval)
			);
			key++;
			*val++ = mval[1];
		}
	}

	SET_END(key);
	SET_END(val);
	FRM_KEYLIST(frame)->tail = frame->tail = cnt + 1;

	return frame;
}