Beispiel #1
0
*/	REBINT Awake_System(REBSER *ports, REBINT only)
/*
**	Returns:
**		-1 for errors
**		 0 for nothing to do
**		 1 for wait is satisifed
**
***********************************************************************/
{
	REBVAL *port;
	REBVAL *state;
	REBVAL *waked;
	REBVAL *awake;
	REBVAL tmp;
	REBVAL ref_only;
	REBINT result;
	REBVAL out;

	// Get the system port object:
	port = Get_System(SYS_PORTS, PORTS_SYSTEM);
	if (!IS_PORT(port)) return -10; // verify it is a port object

	// Get wait queue block (the state field):
	state = VAL_OBJ_VALUE(port, STD_PORT_STATE);
	if (!IS_BLOCK(state)) return -10;
	//Debug_Num("S", VAL_TAIL(state));

	// Get waked queue block:
	waked = VAL_OBJ_VALUE(port, STD_PORT_DATA);
	if (!IS_BLOCK(waked)) return -10;

	// If there is nothing new to do, return now:
	if (VAL_TAIL(state) == 0 && VAL_TAIL(waked) == 0) return -1;

	//Debug_Num("A", VAL_TAIL(waked));
	// Get the system port AWAKE function:
	awake = VAL_OBJ_VALUE(port, STD_PORT_AWAKE);
	if (!ANY_FUNC(awake)) return -1;
	if (ports) Val_Init_Block(&tmp, ports);
	else SET_NONE(&tmp);

	if (only) SET_TRUE(&ref_only);
	else SET_NONE(&ref_only);
	// Call the system awake function:
	if (Apply_Func_Throws(&out, awake, port, &tmp, &ref_only, 0))
		raise Error_No_Catch_For_Throw(&out);

	// Awake function returns 1 for end of WAIT:
	result = (IS_LOGIC(&out) && VAL_LOGIC(&out)) ? 1 : 0;

	return result;
}
Beispiel #2
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));
}
Beispiel #3
0
*/	void Do_Command(REBVAL *value)
/*
**	Evaluates the arguments for a command function and creates
**	a resulting stack frame (struct or object) for command processing.
**
**	A command value consists of:
**		args - same as other funcs
**		spec - same as other funcs
**		body - [ext-obj func-index]
**
***********************************************************************/
{
	REBVAL *val = BLK_HEAD(VAL_FUNC_BODY(value));
	REBEXT *ext;
	REBCNT cmd;
	REBCNT argc;
	REBCNT n;
	RXIFRM frm;	// args stored here

	// All of these were checked above on definition:
	val = BLK_HEAD(VAL_FUNC_BODY(value));
	cmd = (int)VAL_INT64(val+1);
	ext = &Ext_List[VAL_I32(VAL_OBJ_VALUE(val, 1))]; // Handler

	// Copy args to command frame (array of args):
	RXA_COUNT(&frm) = argc = SERIES_TAIL(VAL_FUNC_ARGS(value))-1; // not self
	if (argc > 7) Trap0(RE_BAD_COMMAND);
	val = DS_ARG(1);
	for (n = 1; n <= argc; n++, val++) {
		RXA_TYPE(&frm, n) = Reb_To_RXT[VAL_TYPE(val)];
		frm.args[n] = Value_To_RXI(val);
	}

	// Call the command:
	n = ext->call(cmd, &frm, 0);
	val = DS_RETURN;
	switch (n) {
	case RXR_VALUE:
		RXI_To_Value(val, frm.args[1], RXA_TYPE(&frm, 1));
		break;
	case RXR_BLOCK:
		RXI_To_Block(&frm, val);
		break;
	case RXR_UNSET:
		SET_UNSET(val);
		break;
	case RXR_NONE:
		SET_NONE(val);
		break;
	case RXR_TRUE:
		SET_TRUE(val);
		break;
	case RXR_FALSE:
		SET_FALSE(val);
		break;
	case RXR_ERROR:
	default:
		SET_UNSET(val);
	}
}
Beispiel #4
0
*/	REBVAL *Find_Last_Event (REBINT model, REBINT type)
/*
**		Find the last event in the queue by the model
**		Check its type, if it matches, then return the event or NULL
**
**
***********************************************************************/
{
	REBVAL *port;
	REBVAL *value;
	REBVAL *state;

	port = Get_System(SYS_PORTS, PORTS_SYSTEM);
	if (!IS_PORT(port)) return NULL; // verify it is a port object

	// Get queue block:
	state = VAL_OBJ_VALUE(port, STD_PORT_STATE);
	if (!IS_BLOCK(state)) return NULL;
	for (value = VAL_BLK_TAIL(state) - 1; value >= VAL_BLK(state); -- value) {
		if (VAL_EVENT_MODEL(value) == model) {
			if (VAL_EVENT_TYPE(value) == type) {
				return value;
			} else {
				return NULL;
			}
		}
	}

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

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

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

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

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

	VAL_SET(value, REB_COMMAND);
}
Beispiel #6
0
*/	REBVAL *Append_Event(void)
/*
**		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_OBJ_VALUE(port, STD_PORT_STATE);
	if (!IS_BLOCK(state)) return 0;

	// Append to tail if room:
	if (SERIES_FULL(VAL_SERIES(state))) {
		if (VAL_TAIL(state) > EVENTS_LIMIT) {
			Panic_DEAD_END(RP_MAX_EVENTS);
		} else {
			Extend_Series(VAL_SERIES(state), EVENTS_CHUNK);
			//RL_Print("event queue increased to :%d\n", SERIES_REST(VAL_SERIES(state)));
		}
	}
	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;
}
Beispiel #7
0
*/	void Do_Commands(REBSER *cmds, void *context)
/*
**		Evaluate a block of commands as efficiently as possible.
**		The arguments to each command must already be reduced or
**		use only variable lookup.
**
**		Returns the last evaluated value, if provided.
**
***********************************************************************/
{
	REBVAL *blk;
	REBCNT index = 0;
	REBVAL *set_word = 0;
	REBVAL *cmd_word;
	REBSER *words;
	REBVAL *args;
	REBVAL *val;
	REBVAL *func;
	RXIFRM frm;	// args stored here
	REBCNT n;
	REBEXT *ext;
	REBCEC *ctx;

	if ((ctx = context)) ctx->block = cmds;
	blk = BLK_HEAD(cmds);

	while (NOT_END(blk)) {

		// var: command result
		if IS_SET_WORD(blk) {
			set_word = blk++;
			index++;
		};

		// get command function
		if (IS_WORD(cmd_word = blk)) {
			// Optimized var fetch:
			n = VAL_WORD_INDEX(blk);
			if (n > 0) func = FRM_VALUES(VAL_WORD_FRAME(blk)) + n;
			else func = Get_Var(blk); // fallback
		} else func = blk;

		if (!IS_COMMAND(func)) Trap2(RE_EXPECT_VAL, Get_Type_Word(REB_COMMAND), blk);

		// Advance to next value
		blk++;
		if (ctx) ctx->index = index; // position of function
		index++;

		// get command arguments and body
		words = VAL_FUNC_WORDS(func);
		RXA_COUNT(&frm) = SERIES_TAIL(VAL_FUNC_ARGS(func))-1; // not self

		// collect each argument (arg list already validated on MAKE)
		n = 0;
		for (args = BLK_SKIP(words, 1); NOT_END(args); args++) {

			//Debug_Type(args);
			val = blk++;
			index++;
			if (IS_END(val)) Trap2(RE_NO_ARG, cmd_word, args);
			//Debug_Type(val);

			// actual arg is a word, lookup?
			if (VAL_TYPE(val) >= REB_WORD) {
				if (IS_WORD(val)) {
					if (IS_WORD(args)) val = Get_Var(val);
				}
				else if (IS_PATH(val)) {
					if (IS_WORD(args)) val = Get_Any_Var(val); // volatile value!
				}
				else if (IS_PAREN(val)) {
					val = Do_Blk(VAL_SERIES(val), 0); // volatile value!
				}
				// all others fall through
			}

			// check datatype
			if (!TYPE_CHECK(args, VAL_TYPE(val)))
				Trap3(RE_EXPECT_ARG, cmd_word, args, Of_Type(val));

			// put arg into command frame
			n++;
			RXA_TYPE(&frm, n) = Reb_To_RXT[VAL_TYPE(val)];
			frm.args[n] = Value_To_RXI(val);
		}

		// Call the command (also supports different extension modules):
		func  = BLK_HEAD(VAL_FUNC_BODY(func));
		n = (REBCNT)VAL_INT64(func + 1);
		ext = &Ext_List[VAL_I32(VAL_OBJ_VALUE(func, 1))]; // Handler
		n = ext->call(n, &frm, context);
		val = DS_RETURN;
		switch (n) {
		case RXR_VALUE:
			RXI_To_Value(val, frm.args[1], RXA_TYPE(&frm, 1));
			break;
		case RXR_BLOCK:
			RXI_To_Block(&frm, val);
			break;
		case RXR_UNSET:
			SET_UNSET(val);
			break;
		case RXR_NONE:
			SET_NONE(val);
			break;
		case RXR_TRUE:
			SET_TRUE(val);
			break;
		case RXR_FALSE:
			SET_FALSE(val);
			break;
		case RXR_ERROR:
		default:
			SET_UNSET(val);
		}

		if (set_word) {
			Set_Var(set_word, val);
			set_word = 0;
		}
	}
}