示例#1
0
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]);
}
示例#2
0
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);
}
示例#3
0
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();
	}
}
示例#4
0
文件: factor.c 项目: Rogers-zz/factor
/* 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();
}
示例#5
0
void factor_vm::primitive_existsp() {
  vm_char* path = untag_check<byte_array>(ctx->pop())->data<vm_char>();
  ctx->push(tag_boolean(windows_stat(path)));
}
示例#6
0
void factor_vm::box_boolean(bool value)
{
	dpush(tag_boolean(value));
}
示例#7
0
void factor_vm::primitive_quotation_compiled_p() {
  quotation* quot = untag_check<quotation>(ctx->pop());
  ctx->push(tag_boolean(quotation_compiled_p(quot)));
}
示例#8
0
文件: lex.c 项目: mushrom/nscheme
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;
}
示例#9
0
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));
}
示例#10
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));
}
示例#11
0
文件: words.cpp 项目: erg/factor
void factor_vm::primitive_optimized_p()
{
	word *w = untag_check<word>(ctx->peek());
	ctx->replace(tag_boolean(w->code->optimized_p()));
}