/* Might GC */
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;
}
/*
* It is up to the caller to fill in the object's fields in a meaningful
* fashion!
*/
object *factor_vm::allot_large_object(cell type, cell size)
{
/* If tenured space does not have enough room, collect and compact */
if(!data->tenured->can_allot_p(size))
{
primitive_compact_gc();
/* If it still won't fit, grow the heap */
if(!data->tenured->can_allot_p(size))
{
gc(collect_growing_heap_op,
size, /* requested size */
true /* trace contexts? */);
}
}
object *obj = data->tenured->allot(size);
/* Allows initialization code to store old->new pointers
without hitting the write barrier in the common case of
a nursery allocation */
write_barrier(obj,size);
obj->initialize(type);
return obj;
}
void factor_vm::primitive_save_image()
{
/* do a full GC to push everything into tenured space */
primitive_compact_gc();
data_root<byte_array> path(ctx->pop(),this);
path.untag_check(this);
save_image((vm_char *)(path.untagged() + 1));
}
/* Allocates memory */
void factor_vm::general_error(vm_error_type error, cell arg1_, cell arg2_) {
data_root<object> arg1(arg1_, this);
data_root<object> arg2(arg2_, this);
faulting_p = true;
/* If we had an underflow or overflow, data or retain stack
pointers might be out of bounds, so fix them before allocating
anything */
ctx->fix_stacks();
/* If error was thrown during heap scan, we re-enable the GC */
gc_off = false;
/* If the error handler is set, we rewind any C stack frames and
pass the error to user-space. */
if (!current_gc && to_boolean(special_objects[ERROR_HANDLER_QUOT])) {
#ifdef FACTOR_DEBUG
/* Doing a GC here triggers all kinds of funny errors */
primitive_compact_gc();
#endif
/* Now its safe to allocate and GC */
cell error_object =
allot_array_4(tag_fixnum(KERNEL_ERROR), tag_fixnum(error),
arg1.value(), arg2.value());
ctx->push(error_object);
/* Clear the data roots since arg1 and arg2's destructors won't be
called. */
data_roots.clear();
/* The unwind-native-frames subprimitive will clear faulting_p
if it was successfully reached. */
unwind_native_frames(special_objects[ERROR_HANDLER_QUOT],
ctx->callstack_top);
} /* Error was thrown in early startup before error handler is set, so just
crash. */
else {
std::cout << "You have triggered a bug in Factor. Please report.\n";
std::cout << "error: " << error << std::endl;
std::cout << "arg 1: ";
print_obj(std::cout, arg1.value());
std::cout << std::endl;
std::cout << "arg 2: ";
print_obj(std::cout, arg2.value());
std::cout << std::endl;
factorbug();
abort();
}
}
// Allocates memory
void factor_vm::primitive_save_image() {
// We unbox this before doing anything else. This is the only point
// where we might throw an error, so we have to throw an error here since
// later steps destroy the current image.
bool then_die = to_boolean(ctx->pop());
byte_array* path2 = untag_check<byte_array>(ctx->pop());
byte_array* path1 = untag_check<byte_array>(ctx->pop());
// Copy the paths to non-gc memory to avoid them hanging around in
// the saved image.
vm_char* path1_saved = safe_strdup(path1->data<vm_char>());
vm_char* path2_saved = safe_strdup(path2->data<vm_char>());
if (then_die) {
// strip out special_objects data which is set on startup anyway
for (cell i = 0; i < special_object_count; i++)
if (!save_special_p(i))
special_objects[i] = false_object;
// dont trace objects only reachable from context stacks so we don't
// get volatile data saved in the image.
active_contexts.clear();
code->uninitialized_blocks.clear();
// I think clearing the callback heap should be fine too.
callbacks->allocator->initial_free_list(0);
}
// do a full GC to push everything remaining into tenured space
primitive_compact_gc();
// Save the image
bool ret = save_image(path1_saved, path2_saved);
if (then_die) {
exit(ret ? 0 : 1);
}
free(path1_saved);
free(path2_saved);
if (!ret) {
general_error(ERROR_IO, tag_fixnum(errno), false_object);
}
}
