Fix runtime compile warnings; working on native stack traces again

vm/bignumint.h

@@ -46,7 +46,7 @@ typedef F_FIXNUM bignum_digit_type;
 typedef F_FIXNUM bignum_length_type;
 
 /* BIGNUM_TO_POINTER casts a bignum object to a digit array pointer. */
-#define BIGNUM_TO_POINTER(bignum) ((CELL*)AREF(bignum,0))
+#define BIGNUM_TO_POINTER(bignum) ((bignum_digit_type *)AREF(bignum,0))
 
 /* BIGNUM_EXCEPTION is invoked to handle assertion violations. */
 #define BIGNUM_EXCEPTION abort

vm/cpu-amd64.h

@@ -10,5 +10,8 @@ void *native_stack_pointer(void);
 
 typedef struct _F_STACK_FRAME {
 	struct _F_STACK_FRAME *previous;
-	CELL *return_address;
+	CELL return_address;
 } F_STACK_FRAME;
+
+#define PREVIOUS_FRAME(frame) (frame->previous)
+#define RETURN_ADDRESS(frame) (frame->return_address)

vm/cpu-ppc.h

@@ -7,3 +7,6 @@ register CELL cards_offset asm("r16");
 void flush_icache(CELL start, CELL len);
 
 void *native_stack_pointer(void);
+
+#define PREVIOUS_FRAME(frame) (frame->previous)
+#define RETURN_ADDRESS(frame) (frame->return_address)

vm/cpu-x86.h

@@ -8,7 +8,7 @@ INLINE void flush_icache(CELL start, CELL len) {}
 
 void *native_stack_pointer(void);
 
-typedef struct _F_STACK_FRAME {
+typedef CELL F_STACK_FRAME;
-	struct _F_STACK_FRAME *previous;
+
-	CELL *return_address;
+#define PREVIOUS_FRAME(frame) (frame + 1)
-} F_STACK_FRAME;
+#define RETURN_ADDRESS(frame) (*(frame))

vm/data_gc.c

@@ -311,7 +311,7 @@ the user environment and extra roots registered with REGISTER_ROOT */
 void collect_roots(void)
 {
 	int i;
-	F_STACKS *stacks;
+	F_CONTEXT *stacks;
 
 	copy_handle(&T);
 	copy_handle(&bignum_zero);

vm/os-linux-ppc.h

@@ -0,0 +1,4 @@
+typedef struct _F_STACK_FRAME {
+	struct _F_STACK_FRAME *previous;
+	CELL return_address;
+} F_STACK_FRAME;

vm/os-macosx-ppc.h

@@ -1,7 +1,7 @@
 typedef struct _F_STACK_FRAME {
 	struct _F_STACK_FRAME *previous;
 	CELL padding1;
-	CELL *return_address;
+	CELL return_address;
 	CELL padding2;
 } F_STACK_FRAME;
 

vm/platform.h

@@ -27,7 +27,11 @@
 		#ifdef __FreeBSD__
 			#include "os-freebsd.h"
 		#elif defined(linux)
-				#include "os-linux.h"
+			#ifdef FACTOR_PPC
+				#include "os-linux-ppc.h"
+			#endif
+
+			#include "os-linux.h"
 		#elif defined(__sun)
 			#include "os-solaris.h"
 		#else

vm/run.c

@@ -263,19 +263,27 @@ CELL allot_native_stack_trace(void)
 	F_STACK_FRAME *frame = native_stack_pointer();
 	GROWABLE_ARRAY(array);
 
-	while((CELL)frame < (CELL)stack_chain->native_stack_pointer)
+	while(frame < stack_chain->native_stack_pointer)
 	{
-		REGISTER_ARRAY(array);
+		CELL return_address = RETURN_ADDRESS(frame);
-		CELL cell = allot_cell((CELL)frame->return_address);
+
-		UNREGISTER_ARRAY(array);
+		if(return_address >= compiling.base
-		GROWABLE_ADD(array,cell);
+			&& return_address <= compiling.limit)
-		if((CELL)frame->previous <= (CELL)frame)
 		{
-			fprintf(stderr,"Factor warning: unusual C stack layout\n");
+			REGISTER_ARRAY(array);
+			CELL cell = allot_cell(return_address);
+			UNREGISTER_ARRAY(array);
+			GROWABLE_ADD(array,cell);
+		}
+
+		if(PREVIOUS_FRAME(frame) <= frame)
+		{
+			fprintf(stderr,"*** Unusual C stack layout (why?)\n");
 			fflush(stderr);
 			break;
 		}
-		frame = frame->previous;
+
+		frame = PREVIOUS_FRAME(frame);
 	}
 
 	GROWABLE_TRIM(array);
@@ -288,7 +296,7 @@ void throw_error(CELL error, bool keep_stacks)
 	early_error(error);
 
 	REGISTER_ROOT(error);
-	thrown_native_stack_trace = F; /* allot_native_stack_trace(); */
+	thrown_native_stack_trace = allot_native_stack_trace();
 	UNREGISTER_ROOT(error);
 
 	throwing = true;

vm/stack.c

@@ -43,7 +43,7 @@ void save_stacks(void)
 /* called on entry into a compiled callback */
 void nest_stacks(void)
 {
-	F_STACKS *new_stacks = safe_malloc(sizeof(F_STACKS));
+	F_CONTEXT *new_stacks = safe_malloc(sizeof(F_CONTEXT));
 	
 	/* note that these register values are not necessarily valid stack
 	pointers. they are merely saved non-volatile registers, and are
@@ -101,7 +101,7 @@ void unnest_stacks(void)
 
 	extra_roots = stack_chain->extra_roots;
 
-	F_STACKS *old_stacks = stack_chain;
+	F_CONTEXT *old_stacks = stack_chain;
 	stack_chain = old_stacks->next;
 	free(old_stacks);
 }

vm/stack.h

@@ -1,4 +1,4 @@
-typedef struct _F_STACKS {
+typedef struct _F_CONTEXT {
 	/* current datastack top pointer */
 	CELL data;
 	/* saved contents of ds register on entry to callback */
@@ -35,15 +35,15 @@ typedef struct _F_STACKS {
 	CELL extra_roots;
 
 	/* C stack pointer on entry */
-	void *native_stack_pointer;
+	F_STACK_FRAME *native_stack_pointer;
 
 	/* error handler longjmp buffer */
 	JMP_BUF toplevel;
 
-	struct _F_STACKS *next;
+	struct _F_CONTEXT *next;
-} F_STACKS;
+} F_CONTEXT;
 
-F_STACKS *stack_chain;
+F_CONTEXT *stack_chain;
 
 CELL ds_size, rs_size, cs_size;
 

vm/types.c

@@ -245,15 +245,15 @@ void primitive_resize_string(void)
 	void primitive_memory_to_##type##_string(void) \
 	{ \
 		CELL length = unbox_unsigned_cell(); \
-		type *string = (type*)unbox_unsigned_cell(); \
+		const type *string = (const type*)unbox_unsigned_cell(); \
 		dpush(tag_object(memory_to_##type##_string(string,length))); \
 	} \
 	F_STRING *from_##type##_string(const type *str) \
 	{ \
 		CELL length = 0; \
-		type *scan = str; \
+		const type *scan = str; \
 		while(*scan++) length++; \
-		return memory_to_##type##_string((type*)str,length); \
+		return memory_to_##type##_string(str,length); \
 	} \
 	void box_##type##_string(const type *str) \
 	{ \