示例#1
0
文件: a-lib.c 项目: MannyZhong/r3
RL_API void *RL_Make_Block(u32 size)
/*
**	Allocate a new block.
**
**	Returns:
**		A pointer to a block series.
**	Arguments:
**		size - the length of the block. The system will add one extra
**			for the end-of-block marker.
**	Notes:
**		Blocks are allocated with REBOL's internal memory manager.
**		Internal structures may change, so NO assumptions should be made!
**		Blocks are automatically garbage collected if there are
**		no references to them from REBOL code (C code does nothing.)
**		However, you can lock blocks to prevent deallocation. (?? default)
*/
{
	return Make_Block(size);
}
示例#2
0
文件: n-io.c 项目: MannyZhong/r3
*/	static REBSER *File_List_To_Block(REBCHR *str)
/*
**		Convert file directory and file name list to block.
**
***********************************************************************/
{
	REBCNT n;
	REBCNT len = 0;
	REBCHR *start = str;
	REBSER *blk;
	REBSER *dir;

	while (n = LEN_STR(str)) {
		len++;
		str += n + 1; // next
	}

	blk = Make_Block(len);
	SAVE_SERIES(blk);

	// First is a dir path or full file path:
	str = start;
	n = LEN_STR(str);
	dir = To_REBOL_Path(str, n, -1, 0);

	if (len == 1) {
		Set_Series(REB_FILE, Append_Value(blk), dir);
	}
	else {
		str += n + 1; // next
		len = dir->tail;
		while (n = LEN_STR(str)) {
			dir->tail = len;
			Append_Uni_Uni(dir, str, n);
			Set_Series(REB_FILE, Append_Value(blk), Copy_String(dir, 0, -1));
			str += n + 1; // next
		}
	}

	UNSAVE_SERIES(blk);
	return blk;
}
示例#3
0
文件: c-error.c 项目: 51weekend/r3
*/	REBSER *Make_Backtrace(REBINT start)
/*
**		Return a block of backtrace words.
**
***********************************************************************/
{
	REBCNT depth = Stack_Depth();
	REBSER *blk = Make_Block(depth-start);
	REBINT dsf;
	REBVAL *val;

	for (dsf = DSF; dsf > 0; dsf = PRIOR_DSF(dsf)) {
		if (start-- <= 0) {
			val = Append_Value(blk);
			Init_Word(val, VAL_WORD_SYM(DSF_WORD(dsf)));
		}
	}

	return blk;
}
示例#4
0
文件: c-frame.c 项目: MannyZhong/r3
*/  REBSER *Merge_Frames(REBSER *parent, REBSER *child)
/*
**      Create a frame from two frames. Merge common fields.
**      Values from the second frame take precedence. No rebinding.
**
***********************************************************************/
{
	REBSER *wrds;
	REBSER *frame;
	REBVAL *words;
	REBVAL *value;
	REBCNT n;

	// Merge parent and child words. This trick works because the
	// word list is itself a valid block.
	wrds = Collect_Frame(BIND_ALL, parent, BLK_SKIP(FRM_WORD_SERIES(child),1));

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

	// Copy parent values:
	COPY_VALUES(FRM_VALUES(parent)+1, FRM_VALUES(frame)+1, SERIES_TAIL(parent)-1);

	// Copy new words and values:
	words = FRM_WORDS(child)+1;
	value = FRM_VALUES(child)+1;
	for (; NOT_END(words); words++, value++) {
		n = Find_Word_Index(frame, VAL_BIND_SYM(words), FALSE);
		if (n) BLK_HEAD(frame)[n] = *value;
	}

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

	return frame;
}
示例#5
0
文件: t-typeset.c 项目: mbk/ren-c
*/	void Init_Typesets(void)
/*
**		Create typeset variables that are defined above.
**		For example: NUMBER is both integer and decimal.
**		Add the new variables to the system context.
**
***********************************************************************/
{
	REBVAL *value;
	REBINT n;

	Set_Root_Series(ROOT_TYPESETS, Make_Block(40), "typeset presets");

	for (n = 0; Typesets[n]; n += 2) {
		value = Alloc_Tail_Blk(VAL_SERIES(ROOT_TYPESETS));
		VAL_SET(value, REB_TYPESET);
		VAL_TYPESET(value) = Typesets[n+1];
		if (Typesets[n] > 1)
			*Append_Frame(Lib_Context, 0, (REBCNT)(Typesets[n])) = *value;
	}
}
示例#6
0
文件: m-stacks.c 项目: mbk/ren-c
*/	void Init_Stacks(REBCNT size)
/*
***********************************************************************/
{
	// We always keep one call stack chunk frame around for the first
	// call frame push.  The first frame allocated out of it is
	// saved as CS_Root.

	struct Reb_Chunk *chunk = ALLOC(struct Reb_Chunk);
#if !defined(NDEBUG)
	memset(chunk, 0xBD, sizeof(struct Reb_Chunk));
#endif
	chunk->next = NULL;
	CS_Root = cast(struct Reb_Call*, &chunk->payload);

	CS_Top = NULL;
	CS_Running = NULL;

	DS_Series = Make_Block(size);
	Set_Root_Series(TASK_STACK, DS_Series, "data stack"); // uses special GC
}
示例#7
0
文件: f-stubs.c 项目: 51weekend/r3
*/	REBSER *Collect_Set_Words(REBVAL *val)
/*
**		Scan a block, collecting all of its SET words as a block.
**
***********************************************************************/
{
	REBCNT cnt = 0;
	REBVAL *val2 = val;
	REBSER *ser;

	for (; NOT_END(val); val++) if (IS_SET_WORD(val)) cnt++;
	val = val2;

	ser = Make_Block(cnt);
	val2 = BLK_HEAD(ser);
	for (; NOT_END(val); val++) {
		if (IS_SET_WORD(val)) Init_Word(val2++, VAL_WORD_SYM(val));
	}
	SET_END(val2);
	SERIES_TAIL(ser) = cnt;

	return ser;
}
示例#8
0
文件: t-gob.c 项目: xqlab/r3
*/	static REBSER *Pane_To_Block(REBGOB *gob, REBCNT index, REBINT len)
/*
**		Convert pane list of gob pointers to a block of GOB!s.
**
***********************************************************************/
{
    REBSER *ser;
    REBGOB **gp;
    REBVAL *val;

    if (len == -1 || (len + index) > GOB_TAIL(gob)) len = GOB_TAIL(gob) - index;
    if (len < 0) len = 0;

    ser = Make_Block(len);
    ser->tail = len;
    val = BLK_HEAD(ser);
    gp = GOB_HEAD(gob);
    for (; len > 0; len--, val++, gp++) {
        SET_GOB(val, *gp);
    }
    SET_END(val);

    return ser;
}
示例#9
0
文件: a-lib.c 项目: MannyZhong/r3
*/	RL_API void *RL_Extend(REBYTE *source, RXICAL call)
/*
**	Appends embedded extension to system/catalog/boot-exts.
**
**	Returns:
**		A pointer to the REBOL library (see reb-lib.h).
**	Arguments:
**		source - A pointer to a UTF-8 (or ASCII) string that provides
**			extension module header, function definitions, and other
**			related functions and data.
**		call - A pointer to the extension's command dispatcher.
**	Notes:
**		This function simply adds the embedded extension to the
**		boot-exts list. All other processing and initialization
**		happens later during startup. Each embedded extension is
**		queried and init using LOAD-EXTENSION system native.
**		See c:extensions-embedded
**
***********************************************************************/
{
	REBVAL *value;
	REBSER *ser;

	value = BLK_SKIP(Sys_Context, SYS_CTX_BOOT_EXTS);
	if (IS_BLOCK(value)) ser = VAL_SERIES(value);
	else {
		ser = Make_Block(2);
		Set_Block(value, ser);
	}
	value = Append_Value(ser);
	Set_Binary(value, Copy_Bytes(source, -1)); // UTF-8
	value = Append_Value(ser);
	SET_HANDLE(value, call);

	return Extension_Lib();
}
示例#10
0
文件: t-gob.c 项目: xqlab/r3
*/	static REBFLG Get_GOB_Var(REBGOB *gob, REBVAL *word, REBVAL *val)
/*
***********************************************************************/
{
    switch (VAL_WORD_CANON(word)) {

    case SYM_OFFSET:
        SET_PAIR(val, GOB_X(gob), GOB_Y(gob));
        break;

    case SYM_SIZE:
        SET_PAIR(val, GOB_W(gob), GOB_H(gob));
        break;

    case SYM_IMAGE:
        if (GOB_TYPE(gob) == GOBT_IMAGE) {
            // image
        }
        else goto is_none;
        break;

    case SYM_DRAW:
        if (GOB_TYPE(gob) == GOBT_DRAW) {
            Set_Block(val, GOB_CONTENT(gob)); // Note: compiler optimizes SET_BLOCKs below
        }
        else goto is_none;
        break;

    case SYM_TEXT:
        if (GOB_TYPE(gob) == GOBT_TEXT) {
            Set_Block(val, GOB_CONTENT(gob));
        }
        else if (GOB_TYPE(gob) == GOBT_STRING) {
            Set_String(val, GOB_CONTENT(gob));
        }
        else goto is_none;
        break;

    case SYM_EFFECT:
        if (GOB_TYPE(gob) == GOBT_EFFECT) {
            Set_Block(val, GOB_CONTENT(gob));
        }
        else goto is_none;
        break;

    case SYM_COLOR:
        if (GOB_TYPE(gob) == GOBT_COLOR) {
            Set_Tuple_Pixel((REBYTE*)&GOB_CONTENT(gob), val);
        }
        else goto is_none;
        break;

    case SYM_ALPHA:
        SET_INTEGER(val, GOB_ALPHA(gob));
        break;

    case SYM_PANE:
        if (GOB_PANE(gob))
            Set_Block(val, Pane_To_Block(gob, 0, -1));
        else
            Set_Block(val, Make_Block(0));
        break;

    case SYM_PARENT:
        if (GOB_PARENT(gob)) {
            SET_GOB(val, GOB_PARENT(gob));
        }
        else
is_none:
            SET_NONE(val);
        break;

    case SYM_DATA:
        if (GOB_DTYPE(gob) == GOBD_OBJECT) {
            SET_OBJECT(val, GOB_DATA(gob));
        }
        else if (GOB_DTYPE(gob) == GOBD_BLOCK) {
            Set_Block(val, GOB_DATA(gob));
        }
        else if (GOB_DTYPE(gob) == GOBD_STRING) {
            Set_String(val, GOB_DATA(gob));
        }
        else if (GOB_DTYPE(gob) == GOBD_BINARY) {
            SET_BINARY(val, GOB_DATA(gob));
        }
        else if (GOB_DTYPE(gob) == GOBD_INTEGER) {
            SET_INTEGER(val, (REBIPT)GOB_DATA(gob));
        }
        else goto is_none;
        break;

    case SYM_FLAGS:
        Set_Block(val, Flags_To_Block(gob));
        break;

    default:
        return FALSE;
    }
    return TRUE;
}
示例#11
0
文件: t-gob.c 项目: Oldes/r3
*/	REBSER *Gob_To_Block(REBGOB *gob)
/*
**		Used by MOLD to create a block.
**
***********************************************************************/
{
	REBSER *ser = Make_Block(10);
	REBVAL *val;
	REBVAL *val1;
	REBCNT sym;

	val = Append_Value(ser);
	Init_Word(val, SYM_OFFSET);
	VAL_SET(val, REB_SET_WORD);
	val = Append_Value(ser);
	SET_PAIR(val, GOB_X(gob), GOB_Y(gob));

	val = Append_Value(ser);
	Init_Word(val, SYM_SIZE);
	VAL_SET(val, REB_SET_WORD);
	val = Append_Value(ser);
	SET_PAIR(val, GOB_W(gob), GOB_H(gob));

	if (!GET_GOB_FLAG(gob, GOBF_OPAQUE) && GOB_ALPHA(gob) < 255) {
		val = Append_Value(ser);
		Init_Word(val, SYM_ALPHA);
		VAL_SET(val, REB_SET_WORD);
		val = Append_Value(ser);
		SET_INTEGER(val, 255 - GOB_ALPHA(gob));
	}

	if (!GOB_TYPE(gob)) return ser;

	if (GOB_CONTENT(gob)) {
		val1 = Append_Value(ser);
		val = Append_Value(ser);
		switch (GOB_TYPE(gob)) {
		case GOBT_COLOR:
			sym = SYM_COLOR;
			break;
		case GOBT_IMAGE:
			sym = SYM_IMAGE;
			break;
#ifdef HAS_WIDGET_GOB
		case GOBT_WIDGET:
			sym = SYM_WIDGET;
			break;
#endif
		case GOBT_STRING:
		case GOBT_TEXT:
			sym = SYM_TEXT;
			break;
		case GOBT_DRAW:
			sym = SYM_DRAW;
			break;
		case GOBT_EFFECT:
			sym = SYM_EFFECT;
			break;
		}
		Init_Word(val1, sym);
		VAL_SET(val1, REB_SET_WORD);
		Get_GOB_Var(gob, val1, val);
	}

	return ser;
}
示例#12
0
文件: t-gob.c 项目: Oldes/r3
*/	static REBFLG Get_GOB_Var(REBGOB *gob, REBVAL *word, REBVAL *val)
/*
***********************************************************************/
{
	REBSER *data;
	switch (VAL_WORD_CANON(word)) {

	case SYM_OFFSET:
		SET_PAIR(val, GOB_X(gob), GOB_Y(gob));
		break;

	case SYM_SIZE:
		SET_PAIR(val, GOB_W(gob), GOB_H(gob));
		break;

	case SYM_IMAGE:
		if (GOB_TYPE(gob) == GOBT_IMAGE) {
			// image
		}
		else goto is_none;
		break;

#ifdef HAS_WIDGET_GOB
	case SYM_WIDGET:
		data = VAL_SERIES(GOB_WIDGET_SPEC(gob));
		Init_Word(val, VAL_WORD_CANON(BLK_HEAD(data)));
		VAL_SET(val, REB_LIT_WORD);
		break;
#endif

	case SYM_DRAW:
		if (GOB_TYPE(gob) == GOBT_DRAW) {
			Set_Block(val, GOB_CONTENT(gob)); // Note: compiler optimizes SET_BLOCKs below
		}
		else goto is_none;
		break;

	case SYM_TEXT:
		if (GOB_TYPE(gob) == GOBT_TEXT) {
			Set_Block(val, GOB_CONTENT(gob));
		}
		else if (GOB_TYPE(gob) == GOBT_STRING) {
			Set_String(val, GOB_CONTENT(gob));
		}
		else goto is_none;
		break;

	case SYM_EFFECT:
		if (GOB_TYPE(gob) == GOBT_EFFECT) {
			Set_Block(val, GOB_CONTENT(gob));
		}
		else goto is_none;
		break;

	case SYM_COLOR:
		if (GOB_TYPE(gob) == GOBT_COLOR) {
			Set_Tuple_Pixel((REBYTE*)&GOB_CONTENT(gob), val);
		}
		else goto is_none;
		break;

	case SYM_ALPHA:
		SET_INTEGER(val, GOB_ALPHA(gob));
		break;

	case SYM_PANE:
		if (GOB_PANE(gob))
			Set_Block(val, Pane_To_Block(gob, 0, -1));
		else
			Set_Block(val, Make_Block(0));
		break;

	case SYM_PARENT:
		if (GOB_PARENT(gob)) {
			SET_GOB(val, GOB_PARENT(gob));
		}
		else
is_none:
			SET_NONE(val);
		break;

	case SYM_DATA:
#ifdef HAS_WIDGET_GOB
		if (GOB_TYPE(gob) == GOBT_WIDGET) {
			return OS_GET_WIDGET_DATA(gob, val);
		}
#endif
		data = GOB_DATA(gob);
		
		if (GOB_DTYPE(gob) == GOBD_OBJECT) {
			SET_OBJECT(val, data);
		}
		else if (GOB_DTYPE(gob) == GOBD_BLOCK) {
			Set_Block(val, data);
		}
		else if (GOB_DTYPE(gob) == GOBD_STRING) {
			Set_String(val, data);
		}
		else if (GOB_DTYPE(gob) == GOBD_BINARY) {
			SET_BINARY(val, data);
		}
		else if (GOB_DTYPE(gob) == GOBD_INTEGER) {
			SET_INTEGER(val, (REBIPT)data);
		}
		else goto is_none;
		break;

	case SYM_FLAGS:
		Set_Block(val, Flags_To_Block(gob));
		break;

	default:
		return FALSE;
	}
	return TRUE;
}
示例#13
0
文件: t-gob.c 项目: Oldes/r3
*/	static REBFLG Set_GOB_Var(REBGOB *gob, REBVAL *word, REBVAL *val)
/*
***********************************************************************/
{
	REBVAL *spec;
	REBVAL *hndl;

	switch (VAL_WORD_CANON(word)) {
	case SYM_OFFSET:
		return Set_Pair(&(gob->offset), val);

	case SYM_SIZE:
		return Set_Pair(&gob->size, val);

	case SYM_IMAGE:
		CLR_GOB_OPAQUE(gob);
		if (IS_IMAGE(val)) {
			SET_GOB_TYPE(gob, GOBT_IMAGE);
			GOB_W(gob) = (REBD32)VAL_IMAGE_WIDE(val);
			GOB_H(gob) = (REBD32)VAL_IMAGE_HIGH(val);
			GOB_CONTENT(gob) = VAL_SERIES(val);
//			if (!VAL_IMAGE_TRANSP(val)) SET_GOB_OPAQUE(gob);
		}
		else if (IS_NONE(val)) SET_GOB_TYPE(gob, GOBT_NONE);
		else return FALSE;
		break;
#ifdef HAS_WIDGET_GOB
	case SYM_WIDGET:
		//printf("WIDGET GOB\n");
		SET_GOB_TYPE(gob, GOBT_WIDGET);
		SET_GOB_OPAQUE(gob);

		GOB_CONTENT(gob) = Make_Block(4);      // [handle type spec data]
		hndl = Append_Value(GOB_CONTENT(gob));
		       Append_Value(GOB_CONTENT(gob)); // used to cache type on host's side
		spec = Append_Value(GOB_CONTENT(gob));
		       Append_Value(GOB_CONTENT(gob)); // used to cache result data

		SET_HANDLE(hndl, 0, SYM_WIDGET, 0);
		
		if (IS_WORD(val) || IS_LIT_WORD(val)) {
			Set_Block(spec, Make_Block(1));
			Append_Val(VAL_SERIES(spec), val);
		}
		else if (IS_BLOCK(val)) {
			Set_Block(spec, VAL_SERIES(val));
		}
		else return FALSE;
		break;
#endif // HAS_WIDGET_GOB

	case SYM_DRAW:
		CLR_GOB_OPAQUE(gob);
		if (IS_BLOCK(val)) {
			SET_GOB_TYPE(gob, GOBT_DRAW);
			GOB_CONTENT(gob) = VAL_SERIES(val);
		}
		else if (IS_NONE(val)) SET_GOB_TYPE(gob, GOBT_NONE);
		else return FALSE;
		break;

	case SYM_TEXT:
		CLR_GOB_OPAQUE(gob);
		if (IS_BLOCK(val)) {
			SET_GOB_TYPE(gob, GOBT_TEXT);
			GOB_CONTENT(gob) = VAL_SERIES(val);
		}
		else if (IS_STRING(val)) {
			SET_GOB_TYPE(gob, GOBT_STRING);
			GOB_CONTENT(gob) = VAL_SERIES(val);
		}
		else if (IS_NONE(val)) SET_GOB_TYPE(gob, GOBT_NONE);
		else return FALSE;
		break;

	case SYM_EFFECT:
		CLR_GOB_OPAQUE(gob);
		if (IS_BLOCK(val)) {
			SET_GOB_TYPE(gob, GOBT_EFFECT);
			GOB_CONTENT(gob) = VAL_SERIES(val);
		}
		else if (IS_NONE(val)) SET_GOB_TYPE(gob, GOBT_NONE);
		else return FALSE;
		break;

	case SYM_COLOR:
		CLR_GOB_OPAQUE(gob);
		if (IS_TUPLE(val)) {
			SET_GOB_TYPE(gob, GOBT_COLOR);
			Set_Pixel_Tuple((REBYTE*)&GOB_CONTENT(gob), val);
			if (VAL_TUPLE_LEN(val) < 4 || VAL_TUPLE(val)[3] == 255)
				SET_GOB_OPAQUE(gob);
		}
		else if (IS_NONE(val)) SET_GOB_TYPE(gob, GOBT_NONE);
		break;

	case SYM_PANE:
		if (GOB_PANE(gob)) Clear_Series(GOB_PANE(gob));
		if (IS_BLOCK(val))
			Insert_Gobs(gob, VAL_BLK_DATA(val), 0, VAL_BLK_LEN(val), 0);
		else if (IS_GOB(val))
			Insert_Gobs(gob, val, 0, 1, 0);
		else if (IS_NONE(val))
			gob->pane = 0;
		else
			return FALSE;
		break;

	case SYM_ALPHA:
		GOB_ALPHA(gob) = Clip_Int(Int32(val), 0, 255);
		break;

	case SYM_DATA:
#ifdef HAS_WIDGET_GOB
		if (GOB_TYPE(gob) == GOBT_WIDGET) {
			OS_SET_WIDGET_DATA(gob, val);
		} else {
#endif
		SET_GOB_DTYPE(gob, GOBD_NONE);
		if (IS_OBJECT(val)) {
			SET_GOB_DTYPE(gob, GOBD_OBJECT);
			SET_GOB_DATA(gob, VAL_OBJ_FRAME(val));
		}
		else if (IS_BLOCK(val)) {
			SET_GOB_DTYPE(gob, GOBD_BLOCK);
			SET_GOB_DATA(gob, VAL_SERIES(val));
		}
		else if (IS_STRING(val)) {
			SET_GOB_DTYPE(gob, GOBD_STRING);
			SET_GOB_DATA(gob, VAL_SERIES(val));
		}
		else if (IS_BINARY(val)) {
			SET_GOB_DTYPE(gob, GOBD_BINARY);
			SET_GOB_DATA(gob, VAL_SERIES(val));
		}
		else if (IS_INTEGER(val)) {
			SET_GOB_DTYPE(gob, GOBD_INTEGER);
			SET_GOB_DATA(gob, (void*)(REBIPT)VAL_INT64(val));
		}
		else if (IS_NONE(val))
			SET_GOB_TYPE(gob, GOBT_NONE);
		else return FALSE;
#ifdef HAS_WIDGET_GOB
		}
#endif
		break;

	case SYM_FLAGS:
		if (IS_WORD(val)) Set_Gob_Flag(gob, val);
		else if (IS_BLOCK(val)) {
			gob->flags = 0;
			for (val = VAL_BLK(val); NOT_END(val); val++) {
				if (IS_WORD(val)) Set_Gob_Flag(gob, val);
			}
		}
		break;

	case SYM_OWNER:
		if (IS_GOB(val))
			GOB_TMP_OWNER(gob) = VAL_GOB(val);
		else
			return FALSE;
		break;

	default:
			return FALSE;
	}
	return TRUE;
}
示例#14
0
文件: t-block.c 项目: 51weekend/r3
*/	void Make_Block_Type(REBFLG make, REBVAL *value, REBVAL *arg)
/*
**		Value can be:
**			1. a datatype (e.g. BLOCK!)
**			2. a value (e.g. [...])
**
**		Arg can be:
**			1. integer (length of block)
**			2. block (copy it)
**			3. value (convert to a block)
**
***********************************************************************/
{
	REBCNT type;
	REBCNT len;
	REBSER *ser;

	// make block! ...
	if (IS_DATATYPE(value))
		type = VAL_DATATYPE(value);
	else  // make [...] ....
		type = VAL_TYPE(value);

	// make block! [1 2 3]
	if (ANY_BLOCK(arg)) {
		len = VAL_BLK_LEN(arg);
		if (len > 0 && type >= REB_PATH && type <= REB_LIT_PATH)
			No_Nones(arg);
		ser = Copy_Values(VAL_BLK_DATA(arg), len);
		goto done;
	}

	if (IS_STRING(arg)) {
		REBCNT index, len = 0;
		VAL_SERIES(arg) = Prep_Bin_Str(arg, &index, &len); // (keeps safe)
		ser = Scan_Source(VAL_BIN(arg), VAL_LEN(arg));
		goto done;
	}

	if (IS_BINARY(arg)) {
		ser = Scan_Source(VAL_BIN_DATA(arg), VAL_LEN(arg));
		goto done;
	}

	if (IS_MAP(arg)) {
		ser = Map_To_Block(VAL_SERIES(arg), 0);
		goto done;
	}

	if (ANY_OBJECT(arg)) {
		ser = Make_Object_Block(VAL_OBJ_FRAME(arg), 3);
		goto done;
	}

	if (IS_VECTOR(arg)) {
		ser = Make_Vector_Block(arg);
		goto done;
	}

//	if (make && IS_NONE(arg)) {
//		ser = Make_Block(0);
//		goto done;
//	}

	// to block! typset
	if (!make && IS_TYPESET(arg) && type == REB_BLOCK) {
		Set_Block(value, Typeset_To_Block(arg));
		return;
	}

	if (make) {
		// make block! 10
		if (IS_INTEGER(arg) || IS_DECIMAL(arg)) {
			len = Int32s(arg, 0);
			Set_Series(type, value, Make_Block(len));
			return;
		}
		Trap_Arg(arg);
	}

	ser = Copy_Values(arg, 1);

done:
	Set_Series(type, value, ser);
	return;
}
示例#15
0
文件: n-loop.c 项目: mbk/ren-c
*/	static REB_R Loop_Each(struct Reb_Call *call_, REBINT mode)
/*
**		Supports these natives (modes):
**			0: foreach
**			1: remove-each
**			2: map
**
***********************************************************************/
{
	REBSER *body;
	REBVAL *vars;
	REBVAL *words;
	REBSER *frame;
	REBVAL *value;
	REBSER *series;
	REBSER *out;	// output block (for MAP, mode = 2)

	REBINT index;	// !!!! should these be REBCNT?
	REBINT tail;
	REBINT windex;	// write
	REBINT rindex;	// read
	REBINT err;
	REBCNT i;
	REBCNT j;
	REBVAL *ds;

	assert(mode >= 0 && mode < 3);

	value = D_ARG(2); // series
	if (IS_NONE(value)) return R_NONE;

	body = Init_Loop(D_ARG(1), D_ARG(3), &frame); // vars, body
	SET_OBJECT(D_ARG(1), frame); // keep GC safe
	Set_Block(D_ARG(3), body);	 // keep GC safe

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

	// If it's MAP, create result block:
	if (mode == 2) {
		out = Make_Block(VAL_LEN(value));
		SAVE_SERIES(out);
	}

	// Get series info:
	if (ANY_OBJECT(value)) {
		series = VAL_OBJ_FRAME(value);
		out = FRM_WORD_SERIES(series); // words (the out local reused)
		index = 1;
		//if (frame->tail > 3) Trap_Arg_DEAD_END(FRM_WORD(frame, 3));
	}
	else if (IS_MAP(value)) {
		series = VAL_SERIES(value);
		index = 0;
		//if (frame->tail > 3) Trap_Arg_DEAD_END(FRM_WORD(frame, 3));
	}
	else {
		series = VAL_SERIES(value);
		index  = VAL_INDEX(value);
		if (index >= cast(REBINT, SERIES_TAIL(series))) {
			if (mode == 1) {
				SET_INTEGER(D_OUT, 0);
			} else if (mode == 2) {
				Set_Block(D_OUT, out);
				UNSAVE_SERIES(out);
			}
			return R_OUT;
		}
	}

	windex = index;

	// Iterate over each value in the series block:
	while (index < (tail = SERIES_TAIL(series))) {

		rindex = index;  // remember starting spot
		j = 0;

		// Set the FOREACH loop variables from the series:
		for (i = 1; i < frame->tail; i++) {

			vars = FRM_VALUE(frame, i);
			words = FRM_WORD(frame, i);

			// var spec is WORD
			if (IS_WORD(words)) {

				if (index < tail) {

					if (ANY_BLOCK(value)) {
						*vars = *BLK_SKIP(series, index);
					}

					else if (ANY_OBJECT(value)) {
						if (!VAL_GET_EXT(BLK_SKIP(out, index), EXT_WORD_HIDE)) {
							// Alternate between word and value parts of object:
							if (j == 0) {
								Init_Word(vars, REB_WORD, VAL_WORD_SYM(BLK_SKIP(out, index)), series, index);
								if (NOT_END(vars+1)) index--; // reset index for the value part
							}
							else if (j == 1)
								*vars = *BLK_SKIP(series, index);
							else
								Trap_Arg_DEAD_END(words);
							j++;
						}
						else {
							// Do not evaluate this iteration
							index++;
							goto skip_hidden;
						}
					}

					else if (IS_VECTOR(value)) {
						Set_Vector_Value(vars, series, index);
					}

					else if (IS_MAP(value)) {
						REBVAL *val = BLK_SKIP(series, index | 1);
						if (!IS_NONE(val)) {
							if (j == 0) {
								*vars = *BLK_SKIP(series, index & ~1);
								if (IS_END(vars+1)) index++; // only words
							}
							else if (j == 1)
								*vars = *BLK_SKIP(series, index);
							else
								Trap_Arg_DEAD_END(words);
							j++;
						}
						else {
							index += 2;
							goto skip_hidden;
						}
					}

					else { // A string or binary
						if (IS_BINARY(value)) {
							SET_INTEGER(vars, (REBI64)(BIN_HEAD(series)[index]));
						}
						else if (IS_IMAGE(value)) {
							Set_Tuple_Pixel(BIN_SKIP(series, index), vars);
						}
						else {
							VAL_SET(vars, REB_CHAR);
							VAL_CHAR(vars) = GET_ANY_CHAR(series, index);
						}
					}
					index++;
				}
				else SET_NONE(vars);
			}

			// var spec is SET_WORD:
			else if (IS_SET_WORD(words)) {
				if (ANY_OBJECT(value) || IS_MAP(value)) {
					*vars = *value;
				} else {
					VAL_SET(vars, REB_BLOCK);
					VAL_SERIES(vars) = series;
					VAL_INDEX(vars) = index;
				}
				//if (index < tail) index++; // do not increment block.
			}
			else Trap_Arg_DEAD_END(words);
		}
		if (index == rindex) index++; //the word block has only set-words: foreach [a:] [1 2 3][]

		if (!DO_BLOCK(D_OUT, body, 0)) {
			if ((err = Check_Error(D_OUT)) >= 0) {
				index = rindex;
				break;
			}
			// else CONTINUE:
			if (mode == 1) SET_FALSE(D_OUT); // keep the value (for mode == 1)
		} else {
			err = 0; // prevent later test against uninitialized value
		}

		if (mode > 0) {
			//if (ANY_OBJECT(value)) Trap_Types_DEAD_END(words, REB_BLOCK, VAL_TYPE(value)); //check not needed

			// If FALSE return, copy values to the write location:
			if (mode == 1) {  // remove-each
				if (IS_CONDITIONAL_FALSE(D_OUT)) {
					REBCNT wide = SERIES_WIDE(series);
					// memory areas may overlap, so use memmove and not memcpy!
					memmove(series->data + (windex * wide), series->data + (rindex * wide), (index - rindex) * wide);
					windex += index - rindex;
					// old: while (rindex < index) *BLK_SKIP(series, windex++) = *BLK_SKIP(series, rindex++);
				}
			}
			else
				if (!IS_UNSET(D_OUT)) Append_Value(out, D_OUT); // (mode == 2)
		}
skip_hidden: ;
	}

	// Finish up:
	if (mode == 1) {
		// Remove hole (updates tail):
		if (windex < index) Remove_Series(series, windex, index - windex);
		SET_INTEGER(D_OUT, index - windex);

		return R_OUT;
	}

	// If MAP...
	if (mode == 2) {
		UNSAVE_SERIES(out);
		if (err != 2) {
			// ...and not BREAK/RETURN:
			Set_Block(D_OUT, out);
			return R_OUT;
		}
	}

	return R_OUT;
}
示例#16
0
文件: u-parse.c 项目: Tectorum/rebol
*/	static REBCNT Do_Eval_Rule(REBPARSE *parse, REBCNT index, REBVAL **rule)
/*
**		Evaluate the input as a code block. Advance input if
**		rule succeeds. Return new index or failure.
**
**		Examples:
**			do skip
**			do end
**			do "abc"
**			do 'abc
**			do [...]
**			do variable
**			do datatype!
**			do quote 123
**			do into [...]
**
**		Problem: cannot write:  set var do datatype!
**
***********************************************************************/
{
	REBVAL value;
	REBVAL *item = *rule;
	REBCNT n;
	REBPARSE newparse;

	// First, check for end of input:
	if (index >= parse->series->tail) {
		if (IS_WORD(item) && VAL_CMD(item) == SYM_END) return index;
		else return NOT_FOUND;
	}

	// Evaluate next N input values:
	index = Do_Next(parse->series, index, FALSE);

	// Value is on top of stack (volatile!):
	value = *DS_POP;
	if (THROWN(&value)) Throw_Break(&value);

	// Get variable or command:
	if (IS_WORD(item)) {

		n = VAL_CMD(item);

		if (n == SYM_SKIP)
			return (IS_SET(&value)) ? index : NOT_FOUND;

		if (n == SYM_QUOTE) {
			item = item + 1;
			(*rule)++;
			if (IS_END(item)) Trap1(RE_PARSE_END, item-2);
			if (IS_PAREN(item)) {
				item = Do_Block_Value_Throw(item); // might GC
			}
		}
		else if (n == SYM_INTO) {
			item = item + 1;
			(*rule)++;
			if (IS_END(item)) Trap1(RE_PARSE_END, item-2);
			item = Get_Parse_Value(item); // sub-rules
			if (!IS_BLOCK(item)) Trap1(RE_PARSE_RULE, item-2);
			if (!ANY_BINSTR(&value) && !ANY_BLOCK(&value)) return NOT_FOUND;
			return (Parse_Series(&value, VAL_BLK_DATA(item), parse->flags, 0) == VAL_TAIL(&value))
				? index : NOT_FOUND;
		}
		else if (n > 0)
			Trap1(RE_PARSE_RULE, item);
		else	
			item = Get_Parse_Value(item); // variable
	}
	else if (IS_PATH(item)) {
		item = Get_Parse_Value(item); // variable
	}
	else if (IS_SET_WORD(item) || IS_GET_WORD(item) || IS_SET_PATH(item) || IS_GET_PATH(item))
		Trap1(RE_PARSE_RULE, item);

	if (IS_NONE(item)) {
		return (VAL_TYPE(&value) > REB_NONE) ? NOT_FOUND : index;
	}

	// Copy the value into its own block:
	newparse.series = Make_Block(1);
	SAVE_SERIES(newparse.series);
	Append_Val(newparse.series, &value);
	newparse.type = REB_BLOCK;
	newparse.flags = parse->flags;
	newparse.result = 0;

	n = (Parse_Next_Block(&newparse, 0, item, 0) != NOT_FOUND) ? index : NOT_FOUND;
	UNSAVE_SERIES(newparse.series);
	return n;
}
示例#17
0
文件: p-dir.c 项目: 51weekend/r3
*/	static int Dir_Actor(REBVAL *ds, REBSER *port, REBCNT action)
/*
**		Internal port handler for file directories.
**
***********************************************************************/
{
	REBVAL *spec;
	REBVAL *path;
	REBVAL *state;
	REBREQ dir;
	REBCNT args = 0;
	REBINT result;
	REBCNT len;
	//REBYTE *flags;

	Validate_Port(port, action);

	*D_RET = *D_ARG(1);
	CLEARS(&dir);

	// Validate and fetch relevant PORT fields:
	spec  = BLK_SKIP(port, STD_PORT_SPEC);
	if (!IS_OBJECT(spec)) Trap1(RE_INVALID_SPEC, spec);
	path = Obj_Value(spec, STD_PORT_SPEC_HEAD_REF);
	if (!path) Trap1(RE_INVALID_SPEC, spec);

	if (IS_URL(path)) path = Obj_Value(spec, STD_PORT_SPEC_HEAD_PATH);
	else if (!IS_FILE(path)) Trap1(RE_INVALID_SPEC, path);
	
	state = BLK_SKIP(port, STD_PORT_STATE); // if block, then port is open.

	//flags = Security_Policy(SYM_FILE, path);

	// Get or setup internal state data:
	dir.port = port;
	dir.device = RDI_FILE;

	switch (action) {

	case A_READ:
		//Trap_Security(flags[POL_READ], POL_READ, path);
		args = Find_Refines(ds, ALL_READ_REFS);
		if (!IS_BLOCK(state)) {		// !!! ignores /SKIP and /PART, for now
			Init_Dir_Path(&dir, path, 1, POL_READ);
			Set_Block(state, Make_Block(7)); // initial guess
			result = Read_Dir(&dir, VAL_SERIES(state));
			///OS_FREE(dir.file.path);
			if (result < 0) Trap_Port(RE_CANNOT_OPEN, port, dir.error);
			*D_RET = *state;
			SET_NONE(state);
		} else {
			len = VAL_BLK_LEN(state);
			// !!? Why does this need to copy the block??
			Set_Block(D_RET, Copy_Block_Values(VAL_SERIES(state), 0, len, TS_STRING));
		}
		break;

	case A_CREATE:
		//Trap_Security(flags[POL_WRITE], POL_WRITE, path);
		if (IS_BLOCK(state)) Trap1(RE_ALREADY_OPEN, path); // already open
create:
		Init_Dir_Path(&dir, path, 0, POL_WRITE | REMOVE_TAIL_SLASH); // Sets RFM_DIR too
		result = OS_DO_DEVICE(&dir, RDC_CREATE);
		///OS_FREE(dir.file.path);
		if (result < 0) Trap1(RE_NO_CREATE, path);
		if (action == A_CREATE) return R_ARG2;
		SET_NONE(state);
		break;

	case A_RENAME:
		if (IS_BLOCK(state)) Trap1(RE_ALREADY_OPEN, path); // already open
		else {
			REBSER *target;

			Init_Dir_Path(&dir, path, 0, POL_WRITE | REMOVE_TAIL_SLASH); // Sets RFM_DIR too
			// Convert file name to OS format:
			if (!(target = Value_To_OS_Path(D_ARG(2)))) Trap1(RE_BAD_FILE_PATH, D_ARG(2));
			dir.data = BIN_DATA(target);
			OS_DO_DEVICE(&dir, RDC_RENAME);
			Free_Series(target);
			if (dir.error) Trap1(RE_NO_RENAME, path);
		}
		break;

	case A_DELETE:
		//Trap_Security(flags[POL_WRITE], POL_WRITE, path);
		SET_NONE(state);
		Init_Dir_Path(&dir, path, 0, POL_WRITE);
		// !!! add *.r deletion
		// !!! add recursive delete (?)
		result = OS_DO_DEVICE(&dir, RDC_DELETE);
		///OS_FREE(dir.file.path);
		if (result < 0) Trap1(RE_NO_DELETE, path);
		return R_ARG2;

	case A_OPEN:
		// !! If open fails, what if user does a READ w/o checking for error?
		if (IS_BLOCK(state)) Trap1(RE_ALREADY_OPEN, path); // already open
		//Trap_Security(flags[POL_READ], POL_READ, path);
		args = Find_Refines(ds, ALL_OPEN_REFS);
		if (args & AM_OPEN_NEW) goto create;
		//if (args & ~AM_OPEN_READ) Trap1(RE_INVALID_SPEC, path);
		Set_Block(state, Make_Block(7));
		Init_Dir_Path(&dir, path, 1, POL_READ);
		result = Read_Dir(&dir, VAL_SERIES(state));
		///OS_FREE(dir.file.path);
		if (result < 0) Trap_Port(RE_CANNOT_OPEN, port, dir.error);
		break;

	case A_OPENQ:
		if (IS_BLOCK(state)) return R_TRUE;
		return R_FALSE;

	case A_CLOSE:
		SET_NONE(state);
		break;

	case A_QUERY:
		//Trap_Security(flags[POL_READ], POL_READ, path);
		SET_NONE(state);
		Init_Dir_Path(&dir, path, -1, REMOVE_TAIL_SLASH | POL_READ);
		if (OS_DO_DEVICE(&dir, RDC_QUERY) < 0) return R_NONE;
		Ret_Query_File(port, &dir, D_RET);
		///OS_FREE(dir.file.path);
		break;

	//-- Port Series Actions (only called if opened as a port)

	case A_LENGTHQ:
		len = IS_BLOCK(state) ? VAL_BLK_LEN(state) : 0;
		SET_INTEGER(D_RET, len);
		break;

	default:
		Trap_Action(REB_PORT, action);
	}

	return R_RET;
}
示例#18
0
*/	static int Event_Actor(REBVAL *ds, REBSER *port, REBCNT action)
/*
***********************************************************************/
{
	REBVAL *spec;
	REBVAL *state;
	REBCNT result;
	REBVAL *arg;
	REBVAL save_port;

	Validate_Port(port, action);

	arg = D_ARG(2);
	*D_RET = *D_ARG(1);

	// Validate and fetch relevant PORT fields:
	state = BLK_SKIP(port, STD_PORT_STATE);
	spec  = BLK_SKIP(port, STD_PORT_SPEC);
	if (!IS_OBJECT(spec)) Trap1(RE_INVALID_SPEC, spec);

	// Get or setup internal state data:
	if (!IS_BLOCK(state)) Set_Block(state, Make_Block(127));

	switch (action) {

	case A_UPDATE:
		return R_NONE;

	// Normal block actions done on events:
	case A_POKE:
		if (!IS_EVENT(D_ARG(3))) Trap_Arg(D_ARG(3));
		goto act_blk;
	case A_INSERT:
	case A_APPEND:
	//case A_PATH:		// not allowed: port/foo is port object field access
	//case A_PATH_SET:	// not allowed: above
		if (!IS_EVENT(arg)) Trap_Arg(arg);
	case A_PICK:
act_blk:
		save_port = *D_ARG(1); // save for return
		*D_ARG(1) = *state;
		result = T_Block(ds, action);
		SET_FLAG(Eval_Signals, SIG_EVENT_PORT);
		if (action == A_INSERT || action == A_APPEND || action == A_REMOVE) {
			*D_RET = save_port;
			break;
		}
		return result; // return condition

	case A_CLEAR:
		VAL_TAIL(state) = 0;
		VAL_BLK_TERM(state);
		CLR_FLAG(Eval_Signals, SIG_EVENT_PORT);
		break;

	case A_LENGTHQ:
		SET_INTEGER(D_RET, VAL_TAIL(state));
		break;

	case A_OPEN:
		if (!req) { //!!!
			req = OS_MAKE_DEVREQ(RDI_EVENT);
			SET_OPEN(req);
			OS_DO_DEVICE(req, RDC_CONNECT);		// stays queued
		}
		break;

	default:
		Trap_Action(REB_PORT, action);
	}

	return R_RET;
}
示例#19
0
文件: p-event.c 项目: mbk/ren-c
*/	static REB_R Event_Actor(struct Reb_Call *call_, REBSER *port, REBCNT action)
/*
**		Internal port handler for events.
**
***********************************************************************/
{
	REBVAL *spec;
	REBVAL *state;
	REB_R result;
	REBVAL *arg;
	REBVAL save_port;

	Validate_Port(port, action);

	arg = D_ARG(2);
	*D_OUT = *D_ARG(1);

	// Validate and fetch relevant PORT fields:
	state = BLK_SKIP(port, STD_PORT_STATE);
	spec  = BLK_SKIP(port, STD_PORT_SPEC);
	if (!IS_OBJECT(spec)) Trap1_DEAD_END(RE_INVALID_SPEC, spec);

	// Get or setup internal state data:
	if (!IS_BLOCK(state)) Set_Block(state, Make_Block(EVENTS_CHUNK - 1));

	switch (action) {

	case A_UPDATE:
		return R_NONE;

	// Normal block actions done on events:
	case A_POKE:
		if (!IS_EVENT(D_ARG(3))) Trap_Arg_DEAD_END(D_ARG(3));
		goto act_blk;
	case A_INSERT:
	case A_APPEND:
	//case A_PATH:		// not allowed: port/foo is port object field access
	//case A_PATH_SET:	// not allowed: above
		if (!IS_EVENT(arg)) Trap_Arg_DEAD_END(arg);
	case A_PICK:
act_blk:
		save_port = *D_ARG(1); // save for return
		*D_ARG(1) = *state;
		result = T_Block(call_, action);
		SET_SIGNAL(SIG_EVENT_PORT);
		if (action == A_INSERT || action == A_APPEND || action == A_REMOVE) {
			*D_OUT = save_port;
			break;
		}
		return result; // return condition

	case A_CLEAR:
		VAL_TAIL(state) = 0;
		VAL_BLK_TERM(state);
		CLR_SIGNAL(SIG_EVENT_PORT);
		break;

	case A_LENGTHQ:
		SET_INTEGER(D_OUT, VAL_TAIL(state));
		break;

	case A_OPEN:
		if (!req) { //!!!
			req = OS_MAKE_DEVREQ(RDI_EVENT);
			if (req) {
				SET_OPEN(req);
				OS_DO_DEVICE(req, RDC_CONNECT);		// stays queued
			}
		}
		break;

	case A_CLOSE:
		OS_ABORT_DEVICE(req);
		OS_DO_DEVICE(req, RDC_CLOSE);
		// free req!!!
		SET_CLOSED(req);
		req = 0;
		break;

	case A_FIND: // add it

	default:
		Trap_Action_DEAD_END(REB_PORT, action);
	}

	return R_OUT;
}