void factor_vm::primitive_dll_validp() {
cell library = ctx->peek();
if (to_boolean(library))
ctx->replace(tag_boolean(untag_check<dll>(library)->handle != NULL));
else
ctx->replace(special_objects[OBJ_CANONICAL_TRUE]);
}
void factor_vm::primitive_dll_validp() {
cell library = ctx->peek();
if (to_boolean(library))
ctx->replace(tag_boolean(untag_check<dll>(library)->handle != NULL));
else
ctx->replace(true_object);
}
void factorvm::init_factor(vm_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();
const vm_char *executable_path = vm_executable_path();
if(executable_path)
p->executable_path = executable_path;
if(p->image_path == NULL)
p->image_path = default_image_path();
srand(current_micros());
init_ffi();
init_stacks(p->ds_size,p->rs_size);
load_image(p);
init_c_io();
init_inline_caching(p->max_pic_size);
init_signals();
if(p->console)
open_console();
init_profiler();
userenv[CPU_ENV] = allot_alien(F,(cell)FACTOR_CPU_STRING);
userenv[OS_ENV] = allot_alien(F,(cell)FACTOR_OS_STRING);
userenv[CELL_SIZE_ENV] = tag_fixnum(sizeof(cell));
userenv[EXECUTABLE_ENV] = allot_alien(F,(cell)p->executable_path);
userenv[ARGS_ENV] = F;
userenv[EMBEDDED_ENV] = F;
/* We can GC now */
gc_off = false;
if(userenv[STAGE2_ENV] == F)
{
userenv[STACK_TRACES_ENV] = tag_boolean(p->stack_traces);
do_stage1_init();
}
}
/* 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();
}
void factor_vm::primitive_existsp() {
vm_char* path = untag_check<byte_array>(ctx->pop())->data<vm_char>();
ctx->push(tag_boolean(windows_stat(path)));
}
void factor_vm::box_boolean(bool value)
{
dpush(tag_boolean(value));
}
void factor_vm::primitive_quotation_compiled_p() {
quotation* quot = untag_check<quotation>(ctx->pop());
ctx->push(tag_boolean(quotation_compiled_p(quot)));
}
scm_value_t read_next_token( parse_state_t *state ){
scm_value_t ret = 0;
int c;
for (;;) {
c = fgetc( state->fp );
if ( feof( state->fp )){
return tag_parse_val( PARSE_TYPE_EOF );
} else if ( c == '\n' ){
state->linenum++;
state->charpos = 0;
} else if ( c == ';' ){
while ( c != '\n' && !feof( state->fp )){
c = fgetc( state->fp );
}
ungetc( c, state->fp );
} else if ( c == '(' ){
return tag_parse_val( PARSE_TYPE_LEFT_PAREN );
} else if ( c == ')' ){
return tag_parse_val( PARSE_TYPE_RIGHT_PAREN );
} else if ( c == '.' ){
return tag_parse_val( PARSE_TYPE_PERIOD );
} else if ( c == '\'' ){
return tag_parse_val( PARSE_TYPE_APOSTROPHE );
} else if ( matches( c, WHITESPACE )){
state->charpos++;
} else if ( matches( c, DIGITS )){
ungetc( c, state->fp );
return read_number( state );
} else if ( matches( c, ALPHABET SYMBOLS)){
ungetc( c, state->fp );
return read_symbol( state );
} else if ( c == '#' ){
int next = fgetc( state->fp );
if ( next == 't' || next == 'f' ){
return tag_boolean( next == 't' );
} else if ( next == '\\' ){
next = fgetc( state->fp );
return tag_character( next );
} else {
ungetc( c, state->fp );
return tag_parse_val( PARSE_TYPE_OCTOTHORPE );
}
} else {
puts( "error!" );
// TODO: error out here
}
}
return ret;
}
void factor_vm::primitive_existsp()
{
struct stat sb;
char *path = (char *)(untag_check<byte_array>(ctx->pop()) + 1);
ctx->push(tag_boolean(stat(path,&sb) >= 0));
}
void factor_vm::primitive_word_optimized_p() {
word* w = untag_check<word>(ctx->peek());
cell t = w->code()->type();
ctx->replace(tag_boolean(t == CODE_BLOCK_OPTIMIZED));
}
void factor_vm::primitive_optimized_p()
{
word *w = untag_check<word>(ctx->peek());
ctx->replace(tag_boolean(w->code->optimized_p()));
}