/* 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));
}
/* 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();
}
/* 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));
}
/* 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));
}
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;
}
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);
}
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;
}
}
}
/* 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);
}
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);
}
/* 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));
}