自学教程：C++ untag_fixnum函数代码示例

void factor_vm::primitive_set_string_nth_slow(){	string *str = untag<string>(ctx->pop());	cell index = untag_fixnum(ctx->pop());	cell value = untag_fixnum(ctx->pop());	set_string_nth_slow(str,index,value);}

cell factor_vm::lookup_tuple_method(cell obj, cell methods){	tuple_layout *layout = untag<tuple_layout>(untag<tuple>(obj)->layout);	array *echelons = untag<array>(methods);	fixnum echelon = untag_fixnum(layout->echelon);	fixnum max_echelon = array_capacity(echelons) - 1;	if(echelon > max_echelon) echelon = max_echelon;       	while(echelon >= 0)	{		cell echelon_methods = array_nth(echelons,echelon);		if(tagged<object>(echelon_methods).type_p(WORD_TYPE))			return echelon_methods;		else if(echelon_methods != F)		{			cell klass = nth_superclass(layout,echelon);			cell hashcode = untag_fixnum(nth_hashcode(layout,echelon));			cell result = search_lookup_hash(echelon_methods,klass,hashcode);			if(result != F)				return result;		}		echelon--;	}	critical_error("Cannot find tuple method",methods);	return F;}

void callback_heap::update(callback *stub){	tagged<array> code_template(parent->userenv[CALLBACK_STUB]);	cell rel_class = untag_fixnum(array_nth(code_template.untagged(),1));	cell offset = untag_fixnum(array_nth(code_template.untagged(),3));	parent->store_address_in_code_block(rel_class,		(cell)(stub + 1) + offset,		(cell)(stub->compiled + 1));	flush_icache((cell)stub,stub->size);}

void jit::emit_relocation(cell code_template_){	data_root<array> code_template(code_template_,parent);	cell capacity = array_capacity(code_template.untagged());	for(cell i = 1; i < capacity; i += 3)	{		relocation_class rel_class = (relocation_class)untag_fixnum(array_nth(code_template.untagged(),i));		relocation_type rel_type = (relocation_type)untag_fixnum(array_nth(code_template.untagged(),i + 1));		cell offset = array_nth(code_template.untagged(),i + 2);		relocation_entry new_entry(rel_type,rel_class,code.count + untag_fixnum(offset));		relocation.append_bytes(&new_entry,sizeof(relocation_entry));	}}

cell factor_vm::compute_relocation(relocation_entry rel, cell index, code_block *compiled){	array *literals = (to_boolean(compiled->literals)		? untag<array>(compiled->literals) : NULL);	cell offset = relocation_offset_of(rel) + (cell)compiled->xt();#define ARG array_nth(literals,index)	switch(relocation_type_of(rel))	{	case RT_PRIMITIVE:		return (cell)primitives[untag_fixnum(ARG)];	case RT_DLSYM:		return (cell)get_rel_symbol(literals,index);	case RT_IMMEDIATE:		return ARG;	case RT_XT:		return (cell)object_xt(ARG);	case RT_XT_PIC:		return (cell)word_xt_pic(untag<word>(ARG));	case RT_XT_PIC_TAIL:		return (cell)word_xt_pic_tail(untag<word>(ARG));	case RT_HERE:	{		fixnum arg = untag_fixnum(ARG);		return (arg >= 0 ? offset + arg : (cell)(compiled + 1) - arg);	}	case RT_THIS:		return (cell)(compiled + 1);	case RT_CONTEXT:		return (cell)&ctx;	case RT_UNTAGGED:		return untag_fixnum(ARG);	case RT_MEGAMORPHIC_CACHE_HITS:		return (cell)&megamorphic_cache_hits;	case RT_VM:		return (cell)this + untag_fixnum(ARG);	case RT_CARDS_OFFSET:		return cards_offset;	case RT_DECKS_OFFSET:		return decks_offset;	default:		critical_error("Bad rel type",rel);		return 0; /* Can't happen */	}#undef ARG}

/* Fixup labels. This is done at compile time, not image load time */void factor_vm::fixup_labels(array *labels, code_block *compiled){	cell size = array_capacity(labels);	for(cell i = 0; i < size; i += 3)	{		relocation_class rel_class = (relocation_class)untag_fixnum(array_nth(labels,i));		cell offset = untag_fixnum(array_nth(labels,i + 1));		cell target = untag_fixnum(array_nth(labels,i + 2));		relocation_entry new_entry(RT_HERE,rel_class,offset);		instruction_operand op(new_entry,compiled,0);		op.store_value(target + (cell)compiled->xt());	}}

void factor_vm::set_string_nth_slow(string *str_, cell index, cell ch){	data_root<string> str(str_,this);	byte_array *aux;	str->data()[index] = ((ch & 0x7f) | 0x80);	if(to_boolean(str->aux))		aux = untag<byte_array>(str->aux);	else	{		/* We don't need to pre-initialize the		byte array with any data, since we		only ever read from the aux vector		if the most significant bit of a		character is set. Initially all of		the bits are clear. */		aux = allot_uninitialized_array<byte_array>(untag_fixnum(str->length) * sizeof(u16));		str->aux = tag<byte_array>(aux);		write_barrier(&str->aux);	}	aux->data<u16>()[index] = (u16)((ch >> 7) ^ 1);}

void factor_vm::primitive_load_locals(){	fixnum count = untag_fixnum(dpop());	memcpy((cell *)(rs + sizeof(cell)),(cell *)(ds - sizeof(cell) * (count - 1)),sizeof(cell) * count);	ds -= sizeof(cell) * count;	rs += sizeof(cell) * count;}

/* Size of the data area of an object pointed to by an untagged pointer */cell factor_vm::unaligned_object_size(object *pointer){    switch(pointer->h.hi_tag())    {    case ARRAY_TYPE:        return array_size((array*)pointer);    case BIGNUM_TYPE:        return array_size((bignum*)pointer);    case BYTE_ARRAY_TYPE:        return array_size((byte_array*)pointer);    case STRING_TYPE:        return string_size(string_capacity((string*)pointer));    case TUPLE_TYPE:        return tuple_size(untag<tuple_layout>(((tuple *)pointer)->layout));    case QUOTATION_TYPE:        return sizeof(quotation);    case WORD_TYPE:        return sizeof(word);    case FLOAT_TYPE:        return sizeof(boxed_float);    case DLL_TYPE:        return sizeof(dll);    case ALIEN_TYPE:        return sizeof(alien);    case WRAPPER_TYPE:        return sizeof(wrapper);    case CALLSTACK_TYPE:        return callstack_size(untag_fixnum(((callstack *)pointer)->length));    default:        critical_error("Invalid header",(cell)pointer);        return 0; /* can't happen */    }}

	void operator()(instruction_operand op)	{		switch(op.rel_type())		{		case RT_LITERAL:			op.store_value(next_literal());			break;		case RT_XT:			op.store_value(parent->compute_xt_address(next_literal()));			break;		case RT_XT_PIC:			op.store_value(parent->compute_xt_pic_address(next_literal()));			break;		case RT_XT_PIC_TAIL:			op.store_value(parent->compute_xt_pic_tail_address(next_literal()));			break;		case RT_HERE:			op.store_value(parent->compute_here_address(next_literal(),op.rel_offset(),op.parent_code_block()));			break;		case RT_UNTAGGED:			op.store_value(untag_fixnum(next_literal()));			break;		default:			parent->store_external_address(op);			break;		}	}

cell factor_vm::compute_here_address(cell arg, cell offset, code_block *compiled){	fixnum n = untag_fixnum(arg);	if(n >= 0)		return (cell)compiled->entry_point() + offset + n;	else		return (cell)compiled->entry_point() - n;}

instruction_operand callback_heap::callback_operand(code_block *stub, cell index){	tagged<array> code_template(parent->special_objects[CALLBACK_STUB]);	cell rel_class = untag_fixnum(array_nth(code_template.untagged(),3 * index + 1));	cell rel_type  = untag_fixnum(array_nth(code_template.untagged(),3 * index + 2));	cell offset    = untag_fixnum(array_nth(code_template.untagged(),3 * index + 3));	relocation_entry rel(		(relocation_type)rel_type,		(relocation_class)rel_class,		offset);	instruction_operand op(rel,stub,0);	return op;}

void jit::emit_relocation(cell code_template_){	gc_root<array> code_template(code_template_,parent_vm);	cell capacity = array_capacity(code_template.untagged());	for(cell i = 1; i < capacity; i += 3)	{		cell rel_class = array_nth(code_template.untagged(),i);		cell rel_type = array_nth(code_template.untagged(),i + 1);		cell offset = array_nth(code_template.untagged(),i + 2);		relocation_entry new_entry			= (untag_fixnum(rel_type) << 28)			| (untag_fixnum(rel_class) << 24)			| ((code.count + untag_fixnum(offset)));		relocation.append_bytes(&new_entry,sizeof(relocation_entry));	}}

void factor_vm::primitive_load_locals() {  fixnum count = untag_fixnum(ctx->pop());  memcpy((cell*)(ctx->retainstack + sizeof(cell)),         (cell*)(ctx->datastack - sizeof(cell) * (count - 1)),         sizeof(cell) * count);  ctx->datastack -= sizeof(cell) * count;  ctx->retainstack += sizeof(cell) * count;}

/* Allocates memory */void factor_vm::primitive_modify_code_heap(){	bool reset_inline_caches = to_boolean(ctx->pop());	bool update_existing_words = to_boolean(ctx->pop());	data_root<array> alist(ctx->pop(),this);	cell count = array_capacity(alist.untagged());	if(count == 0)		return;	for(cell i = 0; i < count; i++)	{		data_root<array> pair(array_nth(alist.untagged(),i),this);		data_root<word> word(array_nth(pair.untagged(),0),this);		data_root<object> data(array_nth(pair.untagged(),1),this);		switch(data.type())		{		case QUOTATION_TYPE:			jit_compile_word(word.value(),data.value(),false);			break;		case ARRAY_TYPE:			{				array *compiled_data = data.as<array>().untagged();				cell parameters = array_nth(compiled_data,0);				cell literals = array_nth(compiled_data,1);				cell relocation = array_nth(compiled_data,2);				cell labels = array_nth(compiled_data,3);				cell code = array_nth(compiled_data,4);				cell frame_size = untag_fixnum(array_nth(compiled_data,5));				code_block *compiled = add_code_block(					code_block_optimized,					code,					labels,					word.value(),					relocation,					parameters,					literals,					frame_size);				word->entry_point = compiled->entry_point();			}			break;		default:			critical_error("Expected a quotation or an array",data.value());			break;		}	}	if(update_existing_words)		update_code_heap_words(reset_inline_caches);	else		initialize_code_blocks();}

void factor_vm::primitive_set_slot() {  fixnum slot = untag_fixnum(ctx->pop());  object* obj = untag<object>(ctx->pop());  cell value = ctx->pop();  cell* slot_ptr = &obj->slots()[slot];  *slot_ptr = value;  write_barrier(slot_ptr);}

// The cache_entries parameter is empty (on cold call site) or has entries// (on cache miss). Called from assembly with the actual return address.// Compilation of the inline cache may trigger a GC, which may trigger a// compaction;// also, the block containing the return address may now be dead. Use a// code_root to take care of the details.// Allocates memorycell factor_vm::inline_cache_miss(cell return_address_) {  code_root return_address(return_address_, this);  bool tail_call_site = tail_call_site_p(return_address.value);#ifdef PIC_DEBUG  FACTOR_PRINT("Inline cache miss at "               << (tail_call_site ? "tail" : "non-tail")               << " call site 0x" << std::hex << return_address.value               << std::dec);  print_callstack();#endif  data_root<array> cache_entries(ctx->pop(), this);  fixnum index = untag_fixnum(ctx->pop());  data_root<array> methods(ctx->pop(), this);  data_root<word> generic_word(ctx->pop(), this);  data_root<object> object(((cell*)ctx->datastack)[-index], this);  cell pic_size = array_capacity(cache_entries.untagged()) / 2;  update_pic_transitions(pic_size);  cell xt = generic_word->entry_point;  if (pic_size < max_pic_size) {    cell klass = object_class(object.value());    cell method = lookup_method(object.value(), methods.value());    data_root<array> new_cache_entries(        add_inline_cache_entry(cache_entries.value(), klass, method), this);    inline_cache_jit jit(generic_word.value(), this);    jit.emit_inline_cache(index, generic_word.value(), methods.value(),                          new_cache_entries.value(), tail_call_site);    code_block* code = jit.to_code_block(CODE_BLOCK_PIC, JIT_FRAME_SIZE);    initialize_code_block(code);    xt = code->entry_point();  }  // Install the new stub.  if (return_address.valid) {    // Since each PIC is only referenced from a single call site,    // if the old call target was a PIC, we can deallocate it immediately,    // instead of leaving dead PICs around until the next GC.    deallocate_inline_cache(return_address.value);    set_call_target(return_address.value, xt);#ifdef PIC_DEBUG    FACTOR_PRINT("Updated " << (tail_call_site ? "tail" : "non-tail")                 << " call site 0x" << std::hex << return_address.value << std::dec                 << " with 0x" << std::hex << (cell)xt << std::dec);    print_callstack();#endif  }  return xt;}

void inline_cache_jit::emit_check(cell klass){	cell code_template;	if(TAG(klass) == FIXNUM_TYPE && untag_fixnum(klass) < HEADER_TYPE)		code_template = parent->userenv[PIC_CHECK_TAG];	else		code_template = parent->userenv[PIC_CHECK];	emit_with(code_template,klass);}

/* This is a little tricky. The iterator may allocate memory, so wekeep the callstack in a GC root and use relative offsets */template<typename Iterator> void factor_vm::iterate_callstack_object(callstack *stack_, Iterator &iterator){	data_root<callstack> stack(stack_,this);	fixnum frame_offset = untag_fixnum(stack->length) - sizeof(stack_frame);	while(frame_offset >= 0)	{		stack_frame *frame = stack->frame_at(frame_offset);		frame_offset -= frame->size;		iterator(frame);	}}

void factor_vm::primitive_set_callstack(){	callstack *stack = untag_check<callstack>(dpop());	set_callstack(stack_chain->callstack_bottom,		stack->top(),		untag_fixnum(stack->length),		memcpy);	/* We cannot return here ... */	critical_error("Bug in set_callstack()",0);}

/* The cache_entries parameter is either f (on cold call site) or an array (on cache miss).Called from assembly with the actual return address */void *factor_vm::inline_cache_miss(cell return_address){	check_code_pointer(return_address);	/* Since each PIC is only referenced from a single call site,	   if the old call target was a PIC, we can deallocate it immediately,	   instead of leaving dead PICs around until the next GC. */	deallocate_inline_cache(return_address);	gc_root<array> cache_entries(dpop(),this);	fixnum index = untag_fixnum(dpop());	gc_root<array> methods(dpop(),this);	gc_root<word> generic_word(dpop(),this);	gc_root<object> object(((cell *)ds)[-index],this);	void *xt;	cell pic_size = inline_cache_size(cache_entries.value());	update_pic_transitions(pic_size);	if(pic_size >= max_pic_size)		xt = megamorphic_call_stub(generic_word.value());	else	{		cell klass = object_class(object.value());		cell method = lookup_method(object.value(),methods.value());		gc_root<array> new_cache_entries(add_inline_cache_entry(							   cache_entries.value(),							   klass,							   method),this);		xt = compile_inline_cache(index,					  generic_word.value(),					  methods.value(),					  new_cache_entries.value(),					  tail_call_site_p(return_address))->xt();	}	/* Install the new stub. */	set_call_target(return_address,xt);#ifdef PIC_DEBUG	printf("Updated %s call site 0x%lx with 0x%lx/n",	       tail_call_site_p(return_address) ? "tail" : "non-tail",	       return_address,	       (cell)xt);#endif	return xt;}

inline cell factor_vm::unbox_array_size(){	cell obj = ctx->peek();	if(TAG(obj) == FIXNUM_TYPE)	{		fixnum n = untag_fixnum(obj);		if(n >= 0 && n < (fixnum)array_size_max)		{			ctx->pop();			return n;		}	}	return unbox_array_size_slow();}

  template <typename Iterator> void each_instruction_operand(Iterator& iter) {    if (!to_boolean(relocation))      return;    byte_array* rels = untag<byte_array>(relocation);    cell index = 0;    cell length = untag_fixnum(rels->capacity) / sizeof(relocation_entry);    for (cell i = 0; i < length; i++) {      relocation_entry rel = rels->data<relocation_entry>()[i];      iter(instruction_operand(rel, this, index));      index += rel.number_of_parameters();    }  }

/* Size of the object pointed to by an untagged pointer */template <typename Fixup> cell object::size(Fixup fixup) const {  if (free_p())    return ((free_heap_block*)this)->size();  switch (type()) {    case ARRAY_TYPE:      return align(array_size((array*)this), data_alignment);    case BIGNUM_TYPE:      return align(array_size((bignum*)this), data_alignment);    case BYTE_ARRAY_TYPE:      return align(array_size((byte_array*)this), data_alignment);    case STRING_TYPE:      return align(string_size(string_capacity((string*)this)), data_alignment);    case TUPLE_TYPE: {      tuple_layout* layout = (tuple_layout*)fixup.translate_data(          untag<object>(((tuple*)this)->layout));      return align(tuple_size(layout), data_alignment);    }    case QUOTATION_TYPE:      return align(sizeof(quotation), data_alignment);    case WORD_TYPE:      return align(sizeof(word), data_alignment);    case FLOAT_TYPE:      return align(sizeof(boxed_float), data_alignment);    case DLL_TYPE:      return align(sizeof(dll), data_alignment);    case ALIEN_TYPE:      return align(sizeof(alien), data_alignment);    case WRAPPER_TYPE:      return align(sizeof(wrapper), data_alignment);    case CALLSTACK_TYPE:      return align(          callstack_object_size(untag_fixnum(((callstack*)this)->length)),          data_alignment);    default:      critical_error("Invalid header in size", (cell)this);      return 0; /* can't happen */  }}

/* Allocates memory */void factor_vm::fill_string(string* str_, cell start, cell capacity,                            cell fill) {  data_root<string> str(str_, this);  if (fill <= 0x7f)    memset(&str->data()[start], (uint8_t)fill, capacity - start);  else {    byte_array* aux;    if (to_boolean(str->aux))      aux = untag<byte_array>(str->aux);    else {      aux =          allot_uninitialized_array<byte_array>(untag_fixnum(str->length) * 2);      str->aux = tag<byte_array>(aux);      write_barrier(&str->aux);    }    uint8_t lo_fill = (uint8_t)((fill & 0x7f) | 0x80);    uint16_t hi_fill = (uint16_t)((fill >> 7) ^ 0x1);    memset(&str->data()[start], lo_fill, capacity - start);    memset_2(&aux->data<uint16_t>()[start], hi_fill,             (capacity - start) * sizeof(uint16_t));  }}

/* Figure out what kind of type check the PIC needs based on the methodsit contains */cell factor_vm::determine_inline_cache_type(array *cache_entries){	bool seen_hi_tag = false, seen_tuple = false;	cell i;	for(i = 0; i < array_capacity(cache_entries); i += 2)	{		cell klass = array_nth(cache_entries,i);		/* Is it a tuple layout? */		switch(TAG(klass))		{		case FIXNUM_TYPE:			{				fixnum type = untag_fixnum(klass);				if(type >= HEADER_TYPE)					seen_hi_tag = true;			}			break;		case ARRAY_TYPE:			seen_tuple = true;			break;		default:			critical_error("Expected a fixnum or array",klass);			break;		}	}	if(seen_hi_tag && seen_tuple) return PIC_HI_TAG_TUPLE;	if(seen_hi_tag && !seen_tuple) return PIC_HI_TAG;	if(!seen_hi_tag && seen_tuple) return PIC_TUPLE;	if(!seen_hi_tag && !seen_tuple) return PIC_TAG;	critical_error("Oops",0);	return 0;}