Example #1
0
/* Do some initialization that we do once only */
void do_stage1_init(void)
{
	print_string("*** Stage 2 early init... ");
	fflush(stdout);

	CELL words = find_all_words();

	REGISTER_ROOT(words);

	CELL i;
	CELL length = array_capacity(untag_object(words));
	for(i = 0; i < length; i++)
	{
		F_WORD *word = untag_word(array_nth(untag_array(words),i));
		REGISTER_UNTAGGED(word);
		default_word_code(word,false);
		UNREGISTER_UNTAGGED(word);
		update_word_xt(word);
	}

	UNREGISTER_ROOT(words);

	iterate_code_heap(relocate_code_block);

	userenv[STAGE2_ENV] = T;

	print_string("done\n");
	fflush(stdout);
}
Example #2
0
/* Allocates memory */
void update_word_xt(F_WORD *word)
{
	/* If we just enabled the profiler, reset call count */
	if(profiling_p)
	{
		if(!word->profiling)
		{
			REGISTER_UNTAGGED(word);
			F_COMPILED *profiling = compile_profiling_stub(word);
			UNREGISTER_UNTAGGED(word);
			word->profiling = profiling;
		}

		word->xt = (XT)(word->profiling + 1);
	}
	else
		word->xt = (XT)(word->code + 1);
}
Example #3
0
void primitive_fread(void)
{
    FILE* file = unbox_alien();
    CELL size = unbox_array_size();

    if(size == 0)
    {
        dpush(tag_object(allot_string(0,0)));
        return;
    }

    F_BYTE_ARRAY *buf = allot_byte_array(size);

    for(;;)
    {
        int c = fread(buf + 1,1,size,file);
        if(c <= 0)
        {
            if(feof(file))
            {
                dpush(F);
                break;
            }
            else
                io_error();
        }
        else
        {
            if(c != size)
            {
                REGISTER_UNTAGGED(buf);
                F_BYTE_ARRAY *new_buf = allot_byte_array(c);
                UNREGISTER_UNTAGGED(buf);
                memcpy(new_buf + 1, buf + 1,c);
                buf = new_buf;
            }
            dpush(tag_object(buf));
            break;
        }
    }
}
Example #4
0
void init_factor_from_args(F_CHAR *image, int argc, F_CHAR **argv, bool embedded)
{
	F_PARAMETERS p;
	default_parameters(&p);

	if(image) p.image = image;

	CELL i;

	posix_argc = argc;
	posix_argv = safe_malloc(argc * sizeof(F_CHAR*));
	posix_argv[0] = safe_strdup(argv[0]);

	for(i = 1; i < argc; i++)
	{
		posix_argv[i] = safe_strdup(argv[i]);
		if(factor_arg(argv[i],STR_FORMAT("-datastack=%d"),&p.ds_size));
		else if(factor_arg(argv[i],STR_FORMAT("-retainstack=%d"),&p.rs_size));
		else if(factor_arg(argv[i],STR_FORMAT("-generations=%d"),&p.gen_count));
		else if(factor_arg(argv[i],STR_FORMAT("-young=%d"),&p.young_size));
		else if(factor_arg(argv[i],STR_FORMAT("-aging=%d"),&p.aging_size));
		else if(factor_arg(argv[i],STR_FORMAT("-tenured=%d"),&p.tenured_size));
		else if(factor_arg(argv[i],STR_FORMAT("-codeheap=%d"),&p.code_size));
		else if(STRCMP(argv[i],STR_FORMAT("-securegc")) == 0)
			p.secure_gc = true;
		else if(STRCMP(argv[i],STR_FORMAT("-fep")) == 0)
			p.fep = true;
		else if(STRNCMP(argv[i],STR_FORMAT("-i="),3) == 0)
			p.image = argv[i] + 3;
		else if(STRCMP(argv[i],STR_FORMAT("-console")) == 0)
			p.console = true;
		else if(STRCMP(argv[i],STR_FORMAT("-no-stack-traces")) == 0)
			p.stack_traces = false;
	}

	init_factor(&p);
	nest_stacks();

	F_ARRAY *args = allot_array(ARRAY_TYPE,argc,F);

	for(i = 1; i < argc; i++)
	{
		REGISTER_UNTAGGED(args);
		CELL arg = tag_object(from_native_string(argv[i]));
		UNREGISTER_UNTAGGED(args);
		set_array_nth(args,i,arg);
	}

	userenv[ARGS_ENV] = tag_object(args);

	const F_CHAR *executable_path = vm_executable_path();
	if(!executable_path)
		executable_path = argv[0];

	userenv[EXECUTABLE_ENV] = tag_object(from_native_string(executable_path));
	userenv[EMBEDDED_ENV] = (embedded ? T : F);

	if(p.fep)
		factorbug();

	c_to_factor_toplevel(userenv[BOOT_ENV]);
	unnest_stacks();

	for(i = 0; i < argc; i++)
		free(posix_argv[i]);
	free(posix_argv);
}