496 lines
		
	
	
		
			16 KiB
		
	
	
	
		
			C++
		
	
	
			
		
		
	
	
			496 lines
		
	
	
		
			16 KiB
		
	
	
	
		
			C++
		
	
	
#include "master.hpp"
 | 
						|
 | 
						|
namespace factor {
 | 
						|
 | 
						|
cell code_block::owner_quot() const {
 | 
						|
  tagged<object> executing(owner);
 | 
						|
  if (!optimized_p() && executing->type() == WORD_TYPE)
 | 
						|
    executing = executing.as<word>()->def;
 | 
						|
  return executing.value();
 | 
						|
}
 | 
						|
 | 
						|
cell code_block::scan(factor_vm* vm, void* addr) const {
 | 
						|
  switch (type()) {
 | 
						|
    case code_block_unoptimized: {
 | 
						|
      tagged<object> obj(owner);
 | 
						|
      if (obj.type_p(WORD_TYPE))
 | 
						|
        obj = obj.as<word>()->def;
 | 
						|
 | 
						|
      if (obj.type_p(QUOTATION_TYPE))
 | 
						|
        return tag_fixnum(
 | 
						|
            vm->quot_code_offset_to_scan(obj.value(), offset(addr)));
 | 
						|
      else
 | 
						|
        return false_object;
 | 
						|
    }
 | 
						|
    case code_block_optimized:
 | 
						|
    case code_block_pic:
 | 
						|
      return false_object;
 | 
						|
    default:
 | 
						|
      critical_error("Bad frame type", type());
 | 
						|
      return false_object;
 | 
						|
  }
 | 
						|
}
 | 
						|
 | 
						|
cell factor_vm::compute_entry_point_address(cell obj) {
 | 
						|
  switch (tagged<object>(obj).type()) {
 | 
						|
    case WORD_TYPE:
 | 
						|
      return (cell)untag<word>(obj)->entry_point;
 | 
						|
    case QUOTATION_TYPE:
 | 
						|
      return (cell)untag<quotation>(obj)->entry_point;
 | 
						|
    default:
 | 
						|
      critical_error("Expected word or quotation", obj);
 | 
						|
      return 0;
 | 
						|
  }
 | 
						|
}
 | 
						|
 | 
						|
cell factor_vm::compute_entry_point_pic_address(word* w, cell tagged_quot) {
 | 
						|
  if (!to_boolean(tagged_quot) || max_pic_size == 0)
 | 
						|
    return (cell)w->entry_point;
 | 
						|
  else {
 | 
						|
    quotation* quot = untag<quotation>(tagged_quot);
 | 
						|
    if (quot_compiled_p(quot))
 | 
						|
      return (cell)quot->entry_point;
 | 
						|
    else
 | 
						|
      return (cell)w->entry_point;
 | 
						|
  }
 | 
						|
}
 | 
						|
 | 
						|
cell factor_vm::compute_entry_point_pic_address(cell w_) {
 | 
						|
  tagged<word> w(w_);
 | 
						|
  return compute_entry_point_pic_address(w.untagged(), w->pic_def);
 | 
						|
}
 | 
						|
 | 
						|
cell factor_vm::compute_entry_point_pic_tail_address(cell w_) {
 | 
						|
  tagged<word> w(w_);
 | 
						|
  return compute_entry_point_pic_address(w.untagged(), w->pic_tail_def);
 | 
						|
}
 | 
						|
 | 
						|
cell factor_vm::code_block_owner(code_block* compiled) {
 | 
						|
  tagged<object> owner(compiled->owner);
 | 
						|
 | 
						|
  /* Cold generic word call sites point to quotations that call the
 | 
						|
     inline-cache-miss and inline-cache-miss-tail primitives. */
 | 
						|
  if (owner.type_p(QUOTATION_TYPE)) {
 | 
						|
    tagged<quotation> quot(owner.as<quotation>());
 | 
						|
    tagged<array> elements(quot->array);
 | 
						|
 | 
						|
    FACTOR_ASSERT(array_capacity(elements.untagged()) == 5);
 | 
						|
    FACTOR_ASSERT(array_nth(elements.untagged(), 4) ==
 | 
						|
                      special_objects[PIC_MISS_WORD] ||
 | 
						|
                  array_nth(elements.untagged(), 4) ==
 | 
						|
                      special_objects[PIC_MISS_TAIL_WORD]);
 | 
						|
 | 
						|
    tagged<wrapper> word_wrapper(array_nth(elements.untagged(), 0));
 | 
						|
    return word_wrapper->object;
 | 
						|
  } else
 | 
						|
    return compiled->owner;
 | 
						|
}
 | 
						|
 | 
						|
struct update_word_references_relocation_visitor {
 | 
						|
  factor_vm* parent;
 | 
						|
  bool reset_inline_caches;
 | 
						|
 | 
						|
  update_word_references_relocation_visitor(factor_vm* parent,
 | 
						|
                                            bool reset_inline_caches)
 | 
						|
      : parent(parent), reset_inline_caches(reset_inline_caches) {}
 | 
						|
 | 
						|
  void operator()(instruction_operand op) {
 | 
						|
    switch (op.rel_type()) {
 | 
						|
      case RT_ENTRY_POINT: {
 | 
						|
        code_block* compiled = op.load_code_block();
 | 
						|
        cell owner = compiled->owner;
 | 
						|
        if (to_boolean(owner))
 | 
						|
          op.store_value(parent->compute_entry_point_address(owner));
 | 
						|
        break;
 | 
						|
      }
 | 
						|
      case RT_ENTRY_POINT_PIC: {
 | 
						|
        code_block* compiled = op.load_code_block();
 | 
						|
        if (reset_inline_caches || !compiled->pic_p()) {
 | 
						|
          cell owner = parent->code_block_owner(compiled);
 | 
						|
          if (to_boolean(owner))
 | 
						|
            op.store_value(parent->compute_entry_point_pic_address(owner));
 | 
						|
        }
 | 
						|
        break;
 | 
						|
      }
 | 
						|
      case RT_ENTRY_POINT_PIC_TAIL: {
 | 
						|
        code_block* compiled = op.load_code_block();
 | 
						|
        if (reset_inline_caches || !compiled->pic_p()) {
 | 
						|
          cell owner = parent->code_block_owner(compiled);
 | 
						|
          if (to_boolean(owner))
 | 
						|
            op.store_value(parent->compute_entry_point_pic_tail_address(owner));
 | 
						|
        }
 | 
						|
        break;
 | 
						|
      }
 | 
						|
      default:
 | 
						|
        break;
 | 
						|
    }
 | 
						|
  }
 | 
						|
};
 | 
						|
 | 
						|
/* Relocate new code blocks completely; updating references to literals,
 | 
						|
   dlsyms, and words. For all other words in the code heap, we only need
 | 
						|
   to update references to other words, without worrying about literals
 | 
						|
   or dlsyms. */
 | 
						|
void factor_vm::update_word_references(code_block* compiled,
 | 
						|
                                       bool reset_inline_caches) {
 | 
						|
  if (code->uninitialized_p(compiled))
 | 
						|
    initialize_code_block(compiled);
 | 
						|
  /* update_word_references() is always applied to every block in
 | 
						|
     the code heap. Since it resets all call sites to point to
 | 
						|
     their canonical entry point (cold entry point for non-tail calls,
 | 
						|
     standard entry point for tail calls), it means that no PICs
 | 
						|
     are referenced after this is done. So instead of polluting
 | 
						|
     the code heap with dead PICs that will be freed on the next
 | 
						|
     GC, we add them to the free list immediately. */
 | 
						|
  else if (reset_inline_caches && compiled->pic_p())
 | 
						|
    code->free(compiled);
 | 
						|
  else {
 | 
						|
    update_word_references_relocation_visitor visitor(this,
 | 
						|
                                                      reset_inline_caches);
 | 
						|
    compiled->each_instruction_operand(visitor);
 | 
						|
    compiled->flush_icache();
 | 
						|
  }
 | 
						|
}
 | 
						|
 | 
						|
/* Look up an external library symbol referenced by a compiled code block */
 | 
						|
cell factor_vm::compute_dlsym_address(array* parameters, cell index) {
 | 
						|
  cell symbol = array_nth(parameters, index);
 | 
						|
  cell library = array_nth(parameters, index + 1);
 | 
						|
 | 
						|
  dll* d = (to_boolean(library) ? untag<dll>(library) : NULL);
 | 
						|
 | 
						|
  void* undefined_symbol = (void*)factor::undefined_symbol;
 | 
						|
  undefined_symbol = FUNCTION_CODE_POINTER(undefined_symbol);
 | 
						|
  if (d != NULL && !d->handle)
 | 
						|
    return (cell)undefined_symbol;
 | 
						|
 | 
						|
  switch (tagged<object>(symbol).type()) {
 | 
						|
    case BYTE_ARRAY_TYPE: {
 | 
						|
      symbol_char* name = alien_offset(symbol);
 | 
						|
      void* sym = ffi_dlsym(d, name);
 | 
						|
 | 
						|
      if (sym)
 | 
						|
        return (cell)sym;
 | 
						|
      else
 | 
						|
        return (cell)undefined_symbol;
 | 
						|
    }
 | 
						|
    case ARRAY_TYPE: {
 | 
						|
      array* names = untag<array>(symbol);
 | 
						|
      for (cell i = 0; i < array_capacity(names); i++) {
 | 
						|
        symbol_char* name = alien_offset(array_nth(names, i));
 | 
						|
        void* sym = ffi_dlsym(d, name);
 | 
						|
 | 
						|
        if (sym)
 | 
						|
          return (cell)sym;
 | 
						|
      }
 | 
						|
      return (cell)undefined_symbol;
 | 
						|
    }
 | 
						|
    default:
 | 
						|
      critical_error("Bad symbol specifier in compute_dlsym_address", symbol);
 | 
						|
      return (cell)undefined_symbol;
 | 
						|
  }
 | 
						|
}
 | 
						|
 | 
						|
#ifdef FACTOR_PPC
 | 
						|
cell factor_vm::compute_dlsym_toc_address(array* parameters, cell index) {
 | 
						|
  cell symbol = array_nth(parameters, index);
 | 
						|
  cell library = array_nth(parameters, index + 1);
 | 
						|
 | 
						|
  dll* d = (to_boolean(library) ? untag<dll>(library) : NULL);
 | 
						|
 | 
						|
  void* undefined_toc = (void*)factor::undefined_symbol;
 | 
						|
  undefined_toc = FUNCTION_TOC_POINTER(undefined_toc);
 | 
						|
  if (d != NULL && !d->handle)
 | 
						|
    return (cell)undefined_toc;
 | 
						|
 | 
						|
  switch (tagged<object>(symbol).type()) {
 | 
						|
    case BYTE_ARRAY_TYPE: {
 | 
						|
      symbol_char* name = alien_offset(symbol);
 | 
						|
      void* toc = ffi_dlsym_toc(d, name);
 | 
						|
      if (toc)
 | 
						|
        return (cell)toc;
 | 
						|
      else
 | 
						|
        return (cell)undefined_toc;
 | 
						|
    }
 | 
						|
    case ARRAY_TYPE: {
 | 
						|
      array* names = untag<array>(symbol);
 | 
						|
      for (cell i = 0; i < array_capacity(names); i++) {
 | 
						|
        symbol_char* name = alien_offset(array_nth(names, i));
 | 
						|
        void* toc = ffi_dlsym_toc(d, name);
 | 
						|
 | 
						|
        if (toc)
 | 
						|
          return (cell)toc;
 | 
						|
      }
 | 
						|
      return (cell)undefined_toc;
 | 
						|
    }
 | 
						|
    default:
 | 
						|
      critical_error("Bad symbol specifier in compute_dlsym_toc_address", symbol);
 | 
						|
      return (cell)undefined_toc;
 | 
						|
  }
 | 
						|
}
 | 
						|
#endif
 | 
						|
 | 
						|
cell factor_vm::compute_vm_address(cell arg) {
 | 
						|
  return (cell)this + untag_fixnum(arg);
 | 
						|
}
 | 
						|
 | 
						|
void factor_vm::store_external_address(instruction_operand op) {
 | 
						|
  code_block* compiled = op.compiled;
 | 
						|
  array* parameters =
 | 
						|
      (to_boolean(compiled->parameters) ? untag<array>(compiled->parameters)
 | 
						|
                                        : NULL);
 | 
						|
  cell index = op.index;
 | 
						|
 | 
						|
  switch (op.rel_type()) {
 | 
						|
    case RT_DLSYM:
 | 
						|
      op.store_value(compute_dlsym_address(parameters, index));
 | 
						|
      break;
 | 
						|
    case RT_THIS:
 | 
						|
      op.store_value((cell)compiled->entry_point());
 | 
						|
      break;
 | 
						|
    case RT_MEGAMORPHIC_CACHE_HITS:
 | 
						|
      op.store_value((cell)&dispatch_stats.megamorphic_cache_hits);
 | 
						|
      break;
 | 
						|
    case RT_VM:
 | 
						|
      op.store_value(compute_vm_address(array_nth(parameters, index)));
 | 
						|
      break;
 | 
						|
    case RT_CARDS_OFFSET:
 | 
						|
      op.store_value(cards_offset);
 | 
						|
      break;
 | 
						|
    case RT_DECKS_OFFSET:
 | 
						|
      op.store_value(decks_offset);
 | 
						|
      break;
 | 
						|
#ifdef WINDOWS
 | 
						|
    case RT_EXCEPTION_HANDLER:
 | 
						|
      op.store_value((cell)&factor::exception_handler);
 | 
						|
      break;
 | 
						|
#endif
 | 
						|
#ifdef FACTOR_PPC
 | 
						|
    case RT_DLSYM_TOC:
 | 
						|
      op.store_value(compute_dlsym_toc_address(parameters, index));
 | 
						|
      break;
 | 
						|
#endif
 | 
						|
    case RT_INLINE_CACHE_MISS:
 | 
						|
      op.store_value((cell)&factor::inline_cache_miss);
 | 
						|
      break;
 | 
						|
    case RT_SAFEPOINT:
 | 
						|
      op.store_value((cell)code->safepoint_page);
 | 
						|
      break;
 | 
						|
    default:
 | 
						|
      critical_error("Bad rel type in store_external_address()", op.rel_type());
 | 
						|
      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;
 | 
						|
}
 | 
						|
 | 
						|
struct initial_code_block_visitor {
 | 
						|
  factor_vm* parent;
 | 
						|
  cell literals;
 | 
						|
  cell literal_index;
 | 
						|
 | 
						|
  initial_code_block_visitor(factor_vm* parent, cell literals)
 | 
						|
      : parent(parent), literals(literals), literal_index(0) {}
 | 
						|
 | 
						|
  cell next_literal() {
 | 
						|
    return array_nth(untag<array>(literals), literal_index++);
 | 
						|
  }
 | 
						|
 | 
						|
  void operator()(instruction_operand op) {
 | 
						|
    switch (op.rel_type()) {
 | 
						|
      case RT_LITERAL:
 | 
						|
        op.store_value(next_literal());
 | 
						|
        break;
 | 
						|
      case RT_ENTRY_POINT:
 | 
						|
        op.store_value(parent->compute_entry_point_address(next_literal()));
 | 
						|
        break;
 | 
						|
      case RT_ENTRY_POINT_PIC:
 | 
						|
        op.store_value(parent->compute_entry_point_pic_address(next_literal()));
 | 
						|
        break;
 | 
						|
      case RT_ENTRY_POINT_PIC_TAIL:
 | 
						|
        op.store_value(
 | 
						|
            parent->compute_entry_point_pic_tail_address(next_literal()));
 | 
						|
        break;
 | 
						|
      case RT_HERE:
 | 
						|
        op.store_value(parent->compute_here_address(
 | 
						|
            next_literal(), op.rel_offset(), op.compiled));
 | 
						|
        break;
 | 
						|
      case RT_UNTAGGED:
 | 
						|
        op.store_value(untag_fixnum(next_literal()));
 | 
						|
        break;
 | 
						|
      default:
 | 
						|
        parent->store_external_address(op);
 | 
						|
        break;
 | 
						|
    }
 | 
						|
  }
 | 
						|
};
 | 
						|
 | 
						|
/* Perform all fixups on a code block */
 | 
						|
void factor_vm::initialize_code_block(code_block* compiled, cell literals) {
 | 
						|
  initial_code_block_visitor visitor(this, literals);
 | 
						|
  compiled->each_instruction_operand(visitor);
 | 
						|
  compiled->flush_icache();
 | 
						|
 | 
						|
  /* next time we do a minor GC, we have to trace this code block, since
 | 
						|
     the newly-installed instruction operands might point to literals in
 | 
						|
     nursery or aging */
 | 
						|
  code->write_barrier(compiled);
 | 
						|
}
 | 
						|
 | 
						|
void factor_vm::initialize_code_block(code_block* compiled) {
 | 
						|
  std::map<code_block*, cell>::iterator iter =
 | 
						|
      code->uninitialized_blocks.find(compiled);
 | 
						|
  initialize_code_block(compiled, iter->second);
 | 
						|
  code->uninitialized_blocks.erase(iter);
 | 
						|
}
 | 
						|
 | 
						|
/* 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->entry_point());
 | 
						|
  }
 | 
						|
}
 | 
						|
 | 
						|
/* Might GC */
 | 
						|
/* Allocates memory */
 | 
						|
code_block* factor_vm::allot_code_block(cell size, code_block_type type) {
 | 
						|
  code_block* block = code->allocator->allot(size + sizeof(code_block));
 | 
						|
 | 
						|
  /* If allocation failed, do a full GC and compact the code heap.
 | 
						|
     A full GC that occurs as a result of the data heap filling up does not
 | 
						|
     trigger a compaction. This setup ensures that most GCs do not compact
 | 
						|
     the code heap, but if the code fills up, it probably means it will be
 | 
						|
     fragmented after GC anyway, so its best to compact. */
 | 
						|
  if (block == NULL) {
 | 
						|
    primitive_compact_gc();
 | 
						|
    block = code->allocator->allot(size + sizeof(code_block));
 | 
						|
 | 
						|
    /* Insufficient room even after code GC, give up */
 | 
						|
    if (block == NULL) {
 | 
						|
      std::cout << "Code heap used: " << code->allocator->occupied_space()
 | 
						|
                << "\n";
 | 
						|
      std::cout << "Code heap free: " << code->allocator->free_space() << "\n";
 | 
						|
      fatal_error("Out of memory in add-compiled-block", 0);
 | 
						|
    }
 | 
						|
  }
 | 
						|
 | 
						|
  block->set_type(type);
 | 
						|
  return block;
 | 
						|
}
 | 
						|
 | 
						|
/* Might GC */
 | 
						|
/* Allocates memory */
 | 
						|
code_block* factor_vm::add_code_block(code_block_type type, cell code_,
 | 
						|
                                      cell labels_, cell owner_,
 | 
						|
                                      cell relocation_, cell parameters_,
 | 
						|
                                      cell literals_,
 | 
						|
                                      cell frame_size_untagged) {
 | 
						|
  data_root<byte_array> code(code_, this);
 | 
						|
  data_root<object> labels(labels_, this);
 | 
						|
  data_root<object> owner(owner_, this);
 | 
						|
  data_root<byte_array> relocation(relocation_, this);
 | 
						|
  data_root<array> parameters(parameters_, this);
 | 
						|
  data_root<array> literals(literals_, this);
 | 
						|
 | 
						|
  cell code_length = array_capacity(code.untagged());
 | 
						|
  code_block* compiled = allot_code_block(code_length, type);
 | 
						|
 | 
						|
  compiled->owner = owner.value();
 | 
						|
 | 
						|
  /* slight space optimization */
 | 
						|
  if (relocation.type() == BYTE_ARRAY_TYPE &&
 | 
						|
      array_capacity(relocation.untagged()) == 0)
 | 
						|
    compiled->relocation = false_object;
 | 
						|
  else
 | 
						|
    compiled->relocation = relocation.value();
 | 
						|
 | 
						|
  if (parameters.type() == ARRAY_TYPE &&
 | 
						|
      array_capacity(parameters.untagged()) == 0)
 | 
						|
    compiled->parameters = false_object;
 | 
						|
  else
 | 
						|
    compiled->parameters = parameters.value();
 | 
						|
 | 
						|
  /* code */
 | 
						|
  memcpy(compiled + 1, code.untagged() + 1, code_length);
 | 
						|
 | 
						|
  /* fixup labels */
 | 
						|
  if (to_boolean(labels.value()))
 | 
						|
    fixup_labels(labels.as<array>().untagged(), compiled);
 | 
						|
 | 
						|
  compiled->set_stack_frame_size(frame_size_untagged);
 | 
						|
 | 
						|
  /* Once we are ready, fill in literal and word references in this code
 | 
						|
     block's instruction operands. In most cases this is done right after this
 | 
						|
     method returns, except when compiling words with the non-optimizing
 | 
						|
     compiler at the beginning of bootstrap */
 | 
						|
  this->code->uninitialized_blocks.insert(
 | 
						|
      std::make_pair(compiled, literals.value()));
 | 
						|
  this->code->all_blocks.insert((cell)compiled);
 | 
						|
 | 
						|
  /* next time we do a minor GC, we have to trace this code block, since
 | 
						|
     the fields of the code_block struct might point into nursery or aging */
 | 
						|
  this->code->write_barrier(compiled);
 | 
						|
 | 
						|
  return compiled;
 | 
						|
}
 | 
						|
 | 
						|
/* Find the RT_DLSYM relocation nearest to the given return address. */
 | 
						|
struct find_symbol_at_address_visitor {
 | 
						|
  factor_vm* parent;
 | 
						|
  cell return_address;
 | 
						|
  cell symbol;
 | 
						|
  cell library;
 | 
						|
 | 
						|
  find_symbol_at_address_visitor(factor_vm* parent, cell return_address)
 | 
						|
      : parent(parent),
 | 
						|
        return_address(return_address),
 | 
						|
        symbol(false_object),
 | 
						|
        library(false_object) {}
 | 
						|
 | 
						|
  void operator()(instruction_operand op) {
 | 
						|
    if (op.rel_type() == RT_DLSYM && op.pointer <= return_address) {
 | 
						|
      code_block* compiled = op.compiled;
 | 
						|
      array* parameters = untag<array>(compiled->parameters);
 | 
						|
      cell index = op.index;
 | 
						|
      symbol = array_nth(parameters, index);
 | 
						|
      library = array_nth(parameters, index + 1);
 | 
						|
    }
 | 
						|
  }
 | 
						|
};
 | 
						|
 | 
						|
/* References to undefined symbols are patched up to call this function on
 | 
						|
   image load. It finds the symbol and library, and throws an error. */
 | 
						|
void factor_vm::undefined_symbol() {
 | 
						|
  void* frame = ctx->callstack_top;
 | 
						|
  void* return_address = frame_return_address(frame);
 | 
						|
  code_block* compiled = code->code_block_for_address((cell)return_address);
 | 
						|
  find_symbol_at_address_visitor visitor(this, (cell)return_address);
 | 
						|
  compiled->each_instruction_operand(visitor);
 | 
						|
  if (!to_boolean(visitor.symbol))
 | 
						|
    critical_error("Can't find RT_DLSYM at return address",
 | 
						|
                   (cell)return_address);
 | 
						|
  else
 | 
						|
    general_error(ERROR_UNDEFINED_SYMBOL, visitor.symbol, visitor.library);
 | 
						|
}
 | 
						|
 | 
						|
void undefined_symbol() { return current_vm()->undefined_symbol(); }
 | 
						|
 | 
						|
}
 |