vm: Add messages about things that can allocate. Fix a gc bug in the primitive for quotation-code.

vm/alien.cpp

@@ -76,6 +76,7 @@ void factor_vm::primitive_displaced_alien()
 	}
 }
 
+/* Allocates memory (from_unsigned_cell can allocate) */
 /* address of an object representing a C pointer. Explicitly throw an error
 if the object is a byte array, as a sanity check. */
 void factor_vm::primitive_alien_address()

vm/bignum.cpp

@@ -325,6 +325,7 @@ bignum *factor_vm::bignum_remainder(bignum * numerator, bignum * denominator)
 }
 
 /* allocates memory */
+/* cell_to_bignum, fixnum_to_bignum, long_long_to_bignum, ulong_long_to_bignum */
 #define FOO_TO_BIGNUM(name,type,stype,utype)				\
 bignum * factor_vm::name##_to_bignum(type n)				\
 {									\
@@ -361,6 +362,7 @@ FOO_TO_BIGNUM(long_long,s64,s64,u64)
 FOO_TO_BIGNUM(ulong_long,u64,s64,u64)
 
 /* cannot allocate memory */
+/* bignum_to_cell, fixnum_to_cell, long_long_to_cell, ulong_long_to_cell */
 #define BIGNUM_TO_FOO(name,type,stype,utype)				\
 	type factor_vm::bignum_to_##name(bignum * bignum)		\
 	{								\
@@ -389,9 +391,9 @@ BIGNUM_TO_FOO(ulong_long,u64,s64,u64)
 	significand -= ((double) digit);				\
 }
 
-/* allocates memory */
 #define inf std::numeric_limits<double>::infinity()
 
+/* allocates memory */
 bignum *factor_vm::double_to_bignum(double x)
 {
 	if (x == inf || x == -inf || x != x) return (BIGNUM_ZERO ());

vm/byte_arrays.hpp

@@ -14,6 +14,7 @@ struct growable_byte_array {
 	void trim();
 };
 
+/* Allocates memory */
 template<typename Type> byte_array *factor_vm::byte_array_from_value(Type *value)
 {
 	byte_array *data = allot_uninitialized_array<byte_array>(sizeof(Type));

vm/code_heap.cpp

@@ -260,6 +260,7 @@ code_heap_room factor_vm::code_room()
 	return room;
 }
 
+/* Allocates memory */
 void factor_vm::primitive_code_room()
 {
 	code_heap_room room = code_room();

vm/errors.cpp

@@ -118,6 +118,7 @@ void factor_vm::verify_memory_protection_error(cell addr)
 		fatal_error("Memory protection fault during gc", addr);
 }
 
+/* Allocates memory */
 void factor_vm::memory_protection_error(cell pc, cell addr)
 {
 	if(code->safepoint_p(addr))
@@ -138,6 +139,7 @@ void factor_vm::memory_protection_error(cell pc, cell addr)
 		general_error(ERROR_MEMORY,from_unsigned_cell(addr),false_object);
 }
 
+/* Allocates memory */
 void factor_vm::signal_error(cell signal)
 {
 	general_error(ERROR_SIGNAL,from_unsigned_cell(signal),false_object);

vm/generic_arrays.hpp

@@ -19,6 +19,7 @@ template<typename Array> cell array_size(Array *array)
 	return array_size<Array>(array_capacity(array));
 }
 
+/* Allocates memory */
 template<typename Array> Array *factor_vm::allot_uninitialized_array(cell capacity)
 {
 	Array *array = allot<Array>(array_size<Array>(capacity));
@@ -31,6 +32,7 @@ template<typename Array> bool factor_vm::reallot_array_in_place_p(Array *array,
 	return nursery.contains_p(array) && capacity <= array_capacity(array);
 }
 
+/* Allocates memory (sometimes) */
 template<typename Array> Array *factor_vm::reallot_array(Array *array_, cell capacity)
 {
 	data_root<Array> array(array_,this);

vm/io.cpp

@@ -196,6 +196,7 @@ void factor_vm::primitive_fgetc()
 		ctx->push(tag_fixnum(c));
 }
 
+/* Allocates memory */
 void factor_vm::primitive_fread()
 {
 	FILE *file = pop_file_handle();

vm/math.cpp

@@ -13,6 +13,7 @@ void factor_vm::primitive_float_to_fixnum()
 	ctx->replace(tag_fixnum(float_to_fixnum(ctx->peek())));
 }
 
+/* does not allocate, even though from_signed_cell can allocate */
 /* Division can only overflow when we are dividing the most negative fixnum
 by -1. */
 void factor_vm::primitive_fixnum_divint()
@@ -21,17 +22,20 @@ void factor_vm::primitive_fixnum_divint()
 	fixnum x = untag_fixnum(ctx->peek());
 	fixnum result = x / y;
 	if(result == -fixnum_min)
+		/* Does not allocate */
 		ctx->replace(from_signed_cell(-fixnum_min));
 	else
 		ctx->replace(tag_fixnum(result));
 }
 
+/* does not allocate, even though from_signed_cell can allocate */
 void factor_vm::primitive_fixnum_divmod()
 {
 	cell y = ((cell *)ctx->datastack)[0];
 	cell x = ((cell *)ctx->datastack)[-1];
 	if(y == tag_fixnum(-1) && x == tag_fixnum(fixnum_min))
 	{
+		/* Does not allocate */
 		((cell *)ctx->datastack)[-1] = from_signed_cell(-fixnum_min);
 		((cell *)ctx->datastack)[0] = tag_fixnum(0);
 	}
@@ -312,11 +316,13 @@ void factor_vm::primitive_float_greatereq()
 	ctx->push(tag_boolean(x >= y));
 }
 
+/* Allocates memory */
 void factor_vm::primitive_float_bits()
 {
 	ctx->push(from_unsigned_cell(float_bits((float)untag_float_check(ctx->pop()))));
 }
 
+/* Allocates memory */
 void factor_vm::primitive_bits_float()
 {
 	ctx->push(allot_float(bits_float((u32)to_cell(ctx->pop()))));
@@ -362,16 +368,19 @@ VM_C_API cell to_cell(cell tagged, factor_vm *parent)
 	return parent->to_cell(tagged);
 }
 
+/* Allocates memory */
 VM_C_API cell from_signed_cell(fixnum integer, factor_vm *parent)
 {
 	return parent->from_signed_cell(integer);
 }
 
+/* Allocates memory */
 VM_C_API cell from_unsigned_cell(cell integer, factor_vm *parent)
 {
 	return parent->from_unsigned_cell(integer);
 }
 
+/* Allocates memory */
 cell factor_vm::from_signed_8(s64 n)
 {
 	if(n < fixnum_min || n > fixnum_max)

vm/math.hpp

@@ -5,6 +5,7 @@ static const fixnum fixnum_max = (((fixnum)1 << (WORD_SIZE - TAG_BITS - 1)) - 1)
 static const fixnum fixnum_min = (-((fixnum)1 << (WORD_SIZE - TAG_BITS - 1)));
 static const fixnum array_size_max = ((cell)1 << (WORD_SIZE - TAG_BITS - 2));
 
+/* Allocates memory */
 inline cell factor_vm::from_signed_cell(fixnum x)
 {
 	if(x < fixnum_min || x > fixnum_max)
@@ -13,6 +14,7 @@ inline cell factor_vm::from_signed_cell(fixnum x)
 		return tag_fixnum(x);
 }
 
+/* Allocates memory */
 inline cell factor_vm::from_unsigned_cell(cell x)
 {
 	if(x > (cell)fixnum_max)
@@ -21,6 +23,7 @@ inline cell factor_vm::from_unsigned_cell(cell x)
 		return tag_fixnum(x);
 }
 
+/* Allocates memory */
 inline cell factor_vm::allot_float(double n)
 {
 	boxed_float *flo = allot<boxed_float>(sizeof(boxed_float));
@@ -28,6 +31,7 @@ inline cell factor_vm::allot_float(double n)
 	return tag(flo);
 }
 
+/* Allocates memory */
 inline bignum *factor_vm::float_to_bignum(cell tagged)
 {
 	return double_to_bignum(untag_float(tagged));

vm/objects.cpp

@@ -77,6 +77,7 @@ cell factor_vm::object_size(cell tagged)
 		return untag<object>(tagged)->size();
 }
 
+/* Allocates memory */
 void factor_vm::primitive_size()
 {
 	ctx->push(from_unsigned_cell(object_size(ctx->pop())));

vm/quotations.cpp

@@ -361,6 +361,7 @@ void *factor_vm::lazy_jit_compile_entry_point()
 	return untag<word>(special_objects[LAZY_JIT_COMPILE_WORD])->entry_point;
 }
 
+/* Allocates memory */
 /* push a new quotation on the stack */
 void factor_vm::primitive_array_to_quotation()
 {
@@ -374,9 +375,10 @@ void factor_vm::primitive_array_to_quotation()
 	ctx->replace(tag<quotation>(quot));
 }
 
+/* Allocates memory (from_unsigned_cell) */
 void factor_vm::primitive_quotation_code()
 {
-	quotation *quot = untag_check<quotation>(ctx->pop());
+	data_root<quotation> quot(ctx->pop(),this);
 
 	ctx->push(from_unsigned_cell((cell)quot->entry_point));
 	ctx->push(from_unsigned_cell((cell)quot->code() + quot->code()->size()));

vm/strings.cpp

@@ -49,6 +49,7 @@ string *factor_vm::allot_string(cell capacity, cell fill)
 	return str.untagged();
 }
 
+/* Allocates memory */
 void factor_vm::primitive_string()
 {
 	cell initial = to_cell(ctx->pop());
@@ -63,6 +64,7 @@ bool factor_vm::reallot_string_in_place_p(string *str, cell capacity)
 		&& capacity <= string_capacity(str);
 }
 
+/* Allocates memory */
 string* factor_vm::reallot_string(string *str_, cell capacity)
 {
 	data_root<string> str(str_,this);
@@ -104,6 +106,7 @@ string* factor_vm::reallot_string(string *str_, cell capacity)
 	}
 }
 
+/* Allocates memory */
 void factor_vm::primitive_resize_string()
 {
 	data_root<string> str(ctx->pop(),this);

vm/tuples.cpp

@@ -3,6 +3,7 @@
 namespace factor
 {
 
+/* Allocates memory */
 /* push a new tuple on the stack, filling its slots with f */
 void factor_vm::primitive_tuple()
 {
@@ -15,6 +16,7 @@ void factor_vm::primitive_tuple()
 	ctx->push(t.value());
 }
 
+/* Allocates memory */
 /* push a new tuple on the stack, filling its slots from the stack */
 void factor_vm::primitive_tuple_boa()
 {

vm/words.cpp

@@ -40,6 +40,7 @@ void factor_vm::compile_all_words()
 	}
 }
 
+/* Allocates memory */
 word *factor_vm::allot_word(cell name_, cell vocab_, cell hashcode_)
 {
 	data_root<object> vocab(vocab_,this);
@@ -62,6 +63,7 @@ word *factor_vm::allot_word(cell name_, cell vocab_, cell hashcode_)
 	return new_word.untagged();
 }
 
+/* Allocates memory */
 /* (word) ( name vocabulary hashcode -- word ) */
 void factor_vm::primitive_word()
 {
@@ -71,6 +73,7 @@ void factor_vm::primitive_word()
 	ctx->push(tag<word>(allot_word(name,vocab,hashcode)));
 }
 
+/* Allocates memory (from_unsigned_cell allocates) */
 /* word-code ( word -- start end ) */
 void factor_vm::primitive_word_code()
 {
@@ -87,6 +90,7 @@ void factor_vm::primitive_optimized_p()
 	ctx->replace(tag_boolean(w->code()->optimized_p()));
 }
 
+/* Allocates memory */
 void factor_vm::primitive_wrapper()
 {
 	wrapper *new_wrapper = allot<wrapper>(sizeof(wrapper));