Exemple #1
0
/* Allocates memory */
F_COMPILED *compile_profiling_stub(F_WORD *word)
{
	CELL literals = allot_array_1(tag_object(word));
	REGISTER_ROOT(literals);

	F_ARRAY *quadruple = untag_object(userenv[JIT_PROFILING]);

	CELL code = array_nth(quadruple,0);
	REGISTER_ROOT(code);

	F_REL rel;
	rel.type = to_fixnum(array_nth(quadruple,2)) | (to_fixnum(array_nth(quadruple,1)) << 8);
	rel.offset = to_fixnum(array_nth(quadruple,3)) * compiled_code_format();

	F_BYTE_ARRAY *relocation = allot_byte_array(sizeof(F_REL));
	memcpy((void *)BREF(relocation,0),&rel,sizeof(F_REL));

	UNREGISTER_ROOT(code);
	UNREGISTER_ROOT(literals);

	return add_compiled_block(
		WORD_TYPE,
		untag_object(code),
		NULL, /* no labels */
		tag_object(relocation),
		untag_object(literals));
}
Exemple #2
0
/* Get things started */
void init_factor(F_PARAMETERS *p)
{
	/* Kilobytes */
	p->ds_size = align_page(p->ds_size << 10);
	p->rs_size = align_page(p->rs_size << 10);

	/* Megabytes */
	p->young_size <<= 20;
	p->aging_size <<= 20;
	p->tenured_size <<= 20;
	p->code_size <<= 20;

	/* Disable GC during init as a sanity check */
	gc_off = true;

	/* OS-specific initialization */
	early_init();

	if(p->image == NULL)
		p->image = default_image_path();

	srand(current_micros());
	init_ffi();
	init_stacks(p->ds_size,p->rs_size);
	load_image(p);
	init_c_io();
	init_signals();

	if(p->console)
		open_console();

	stack_chain = NULL;
	profiling_p = false;
	performing_gc = false;
	last_code_heap_scan = NURSERY;
	collecting_aging_again = false;

	userenv[CPU_ENV] = tag_object(from_char_string(FACTOR_CPU_STRING));
	userenv[OS_ENV] = tag_object(from_char_string(FACTOR_OS_STRING));
	userenv[CELL_SIZE_ENV] = tag_fixnum(sizeof(CELL));
	userenv[STACK_TRACES_ENV] = tag_boolean(p->stack_traces);

	/* We can GC now */
	gc_off = false;

	if(!stage2)
		do_stage1_init();
}
Exemple #3
0
/* This function also initializes the data and code heaps */
void load_image(F_PARAMETERS *p)
{
	FILE *file = OPEN_READ(p->image);
	if(file == NULL)
	{
		FPRINTF(stderr,"Cannot open image file: %s\n",p->image);
		fprintf(stderr,"%s\n",strerror(errno));
		exit(1);
	}

	F_HEADER h;
	fread(&h,sizeof(F_HEADER),1,file);

	if(h.magic != IMAGE_MAGIC)
		fatal_error("Bad image: magic number check failed",h.magic);

	if(h.version != IMAGE_VERSION)
		fatal_error("Bad image: version number check failed",h.version);
	
	load_data_heap(file,&h,p);
	load_code_heap(file,&h,p);

	fclose(file);

	init_objects(&h);

	relocate_data();
	relocate_code();

	/* Store image path name */
	userenv[IMAGE_ENV] = tag_object(from_native_string(p->image));
}
Exemple #4
0
/* Allocates memory */
F_COMPILED *compile_profiling_stub(F_WORD *word)
{
	CELL literals = allot_array_1(tag_object(word));
	REGISTER_ROOT(literals);

	F_ARRAY *quadruple = untag_object(userenv[JIT_PROFILING]);

	CELL code = array_nth(quadruple,0);
	REGISTER_ROOT(code);

	CELL rel_type = allot_cell(to_fixnum(array_nth(quadruple,2))
		| (to_fixnum(array_nth(quadruple,1)) << 8));
	CELL rel_offset = array_nth(quadruple,3) * compiled_code_format();

	CELL relocation = allot_array_2(rel_type,rel_offset);

	UNREGISTER_ROOT(code);
	UNREGISTER_ROOT(literals);

	return add_compiled_block(
		WORD_TYPE,
		untag_object(code),
		NULL, /* no labels */
		untag_object(relocation),
		untag_object(literals));
}
Exemple #5
0
void ffi_dlclose(F_DLL *dll)
{
	if(dlclose(dll->dll))
	{
		general_error(ERROR_FFI,tag_object(
			from_char_string(dlerror())),F,NULL);
	}
	dll->dll = NULL;
}
Exemple #6
0
void io_error(void)
{
#ifndef WINCE
    if(errno == EINTR)
        return;
#endif

    CELL error = tag_object(from_char_string(strerror(errno)));
    general_error(ERROR_IO,error,F,NULL);
}
Exemple #7
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;
        }
    }
}
Exemple #8
0
/* make an alien */
CELL allot_alien(CELL delegate, CELL displacement)
{
	REGISTER_ROOT(delegate);
	F_ALIEN *alien = allot_object(ALIEN_TYPE,sizeof(F_ALIEN));
	UNREGISTER_ROOT(delegate);

	if(type_of(delegate) == ALIEN_TYPE)
	{
		F_ALIEN *delegate_alien = untag_object(delegate);
		displacement += delegate_alien->displacement;
		alien->alien = delegate_alien->alien;
	}
	else
		alien->alien = delegate;

	alien->displacement = displacement;
	alien->expired = F;
	return tag_object(alien);
}
Exemple #9
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);
}
Exemple #10
0
/* for FFI callbacks receiving structs by value */
void box_value_struct(void *src, CELL size)
{
	F_BYTE_ARRAY *array = allot_byte_array(size);
	memcpy(array + 1,src,size);
	dpush(tag_object(array));
}