callstack>array primitive was not GC safe

vm/callstack.cpp

@@ -107,8 +107,9 @@ stack_frame *frame_successor(stack_frame *frame)
 /* Allocates memory */
 cell frame_scan(stack_frame *frame)
 {
-	if(frame_type(frame) == QUOTATION_TYPE)
+	switch(frame_type(frame))
 	{
+	case QUOTATION_TYPE:
 		cell quot = frame_executing(frame);
 		if(quot == F)
 			return F;
@@ -120,28 +121,27 @@ cell frame_scan(stack_frame *frame)
 			return tag_fixnum(quot_code_offset_to_scan(
 				quot,(cell)(return_addr - quot_xt)));
 		}
-	}
+	case WORD_TYPE:
-	else
 		return F;
+	default:
+		critical_error("Bad frame type",frame_type(frame));
+		return F;
+	}
 }
 
 namespace
 {
 
-struct stack_frame_counter {
-	cell count;
-	stack_frame_counter() : count(0) {}
-	void operator()(stack_frame *frame) { count += 2; }
-};
-
 struct stack_frame_accumulator {
-	cell index;
+	growable_array frames;
-	gc_root<array> frames;
+
-	stack_frame_accumulator(cell count) : index(0), frames(allot_array(count,F)) {}
 	void operator()(stack_frame *frame)
 	{
-		set_array_nth(frames.untagged(),index++,frame_executing(frame));
+		gc_root<object> executing(frame_executing(frame));
-		set_array_nth(frames.untagged(),index++,frame_scan(frame));
+		gc_root<object> scan(frame_scan(frame));
+
+		frames.add(executing.value());
+		frames.add(scan.value());
 	}
 };
 
@@ -151,13 +151,11 @@ PRIMITIVE(callstack_to_array)
 {
 	gc_root<callstack> callstack(dpop());
 
-	stack_frame_counter counter;
+	stack_frame_accumulator accum;
-	iterate_callstack_object(callstack.untagged(),counter);
-
-	stack_frame_accumulator accum(counter.count);
 	iterate_callstack_object(callstack.untagged(),accum);
+	accum.frames.trim();
 
-	dpush(accum.frames.value());
+	dpush(accum.frames.elements.value());
 }
 
 stack_frame *innermost_stack_frame(callstack *stack)

vm/callstack.hpp

@@ -33,9 +33,19 @@ template<typename T> void iterate_callstack(cell top, cell bottom, T &iterator)
 	}
 }
 
-template<typename T> void iterate_callstack_object(callstack *stack, T &iterator)
+/* This is a little tricky. The iterator may allocate memory, so we
+keep the callstack in a GC root and use relative offsets */
+template<typename T> void iterate_callstack_object(callstack *stack_, T &iterator)
 {
-	iterate_callstack((cell)stack->top(),(cell)stack->bottom(),iterator);
+	gc_root<callstack> stack(stack_);
+	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);
+	}
 }
 
 }

vm/layouts.hpp

@@ -309,6 +309,11 @@ struct callstack : public object {
 	/* tagged */
 	cell length;
 	
+	stack_frame *frame_at(cell offset)
+	{
+		return (stack_frame *)((char *)(this + 1) + offset);
+	}
+
 	stack_frame *top() { return (stack_frame *)(this + 1); }
 	stack_frame *bottom() { return (stack_frame *)((cell)(this + 1) + untag_fixnum(length)); }
 };