factor/native/run.c

#include "factor.h"

void signal_handler(int signal, siginfo_t* siginfo, void* uap)
{
	general_error(ERROR_SIGNAL,tag_fixnum(signal));
}

/* Called from a signal handler. XXX - is this safe? */
void call_profiling_step(int signal, siginfo_t* siginfo, void* uap)
{
	CELL depth = (cs - cs_bot) / CELLS;
	int i;
	CELL obj;
	for(i = profile_depth; i < depth; i++)
	{
		obj = get(cs_bot + i * CELLS);
		if(TAG(obj) == WORD_TYPE)
			untag_word(obj)->call_count++;
	}

	executing->call_count++;
}

void init_signals(void)
{
	struct sigaction custom_sigaction;
	struct sigaction profiling_sigaction;
	struct sigaction ign_sigaction;
	custom_sigaction.sa_sigaction = signal_handler;
	custom_sigaction.sa_flags = SA_SIGINFO;
	profiling_sigaction.sa_sigaction = call_profiling_step;
	profiling_sigaction.sa_flags = SA_SIGINFO;
	ign_sigaction.sa_handler = SIG_IGN;
	sigaction(SIGABRT,&custom_sigaction,NULL);
	sigaction(SIGFPE,&custom_sigaction,NULL);
	sigaction(SIGBUS,&custom_sigaction,NULL);
	sigaction(SIGSEGV,&custom_sigaction,NULL);
	sigaction(SIGPIPE,&ign_sigaction,NULL);
	sigaction(SIGPROF,&profiling_sigaction,NULL);
}

void clear_environment(void)
{
	int i;
	for(i = 0; i < USER_ENV; i++)
		userenv[i] = 0;
	profile_depth = 0;
}

#define EXECUTE(w) ((XT)(w->xt))()

void run(void)
{
	CELL next;

	/* Error handling. */
	sigsetjmp(toplevel, 1);
	
	for(;;)
	{
		if(callframe == F)
		{
			callframe = cpop();
			cpop();
			continue;
		}

		callframe = (CELL)untag_cons(callframe);
		next = get(callframe);
		callframe = get(callframe + CELLS);

		if(TAG(next) == WORD_TYPE)
		{
			executing = (WORD*)UNTAG(next);
			EXECUTE(executing);
		}
		else
			dpush(next);
	}
}

/* XT of deferred words */
void undefined()
{
	general_error(ERROR_UNDEFINED_WORD,tag_word(executing));
}

/* XT of compound definitions */
void docol(void)
{
	call(executing->parameter);
}

void primitive_execute(void)
{
	executing = untag_word(dpop());
	EXECUTE(executing);
}

void primitive_call(void)
{
	call(dpop());
}

void primitive_ifte(void)
{
	CELL f = dpop();
	CELL t = dpop();
	CELL cond = dpop();
	call(untag_boolean(cond) ? t : f);
}

void primitive_getenv(void)
{
	FIXNUM e = to_fixnum(dpeek());
	if(e < 0 || e >= USER_ENV)
		range_error(F,e,USER_ENV);
	drepl(userenv[e]);
}

void primitive_setenv(void)
{
	FIXNUM e = to_fixnum(dpop());
	CELL value = dpop();
	if(e < 0 || e >= USER_ENV)
		range_error(F,e,USER_ENV);
	userenv[e] = value;
}

void primitive_call_profiling(void)
{
	CELL d = dpop();
	if(d == F)
	{
		timerclear(&prof_timer.it_interval);
		timerclear(&prof_timer.it_value);

		profile_depth = 0;
	}
	else
	{
		prof_timer.it_interval.tv_sec = 0;
		prof_timer.it_interval.tv_usec = 1000;
		prof_timer.it_value.tv_sec = 0;
		prof_timer.it_value.tv_usec = 1000;

		profile_depth = to_fixnum(d);
	}

	if(setitimer(ITIMER_PROF,&prof_timer,NULL) < 0)
		io_error(__FUNCTION__);
}