got flush-icache to compile

Makefile

@@ -22,7 +22,8 @@ OBJS = $(UNIX_OBJS) native/arithmetic.o native/array.o native/bignum.o \
 	native/word.o native/compiler.o \
 	native/ffi.o native/boolean.o \
 	native/debug.o \
-	native/hashtable.o
+	native/hashtable.o \
+	native/icache.o
 
 default:
 	@echo "Run 'make' with one of the following parameters:"
@@ -75,3 +76,5 @@ clean:
 .c.o:
 	$(CC) -c $(CFLAGS) -o $@ $<
 
+.S.o:
+	$(CC) -c $(CFLAGS) -o $@ $<

library/bootstrap/primitives.factor

@@ -201,6 +201,7 @@ vocabularies get [
     [ "end-scan" "memory"                     [ [ ] [ ] ] ]
     [ "size" "memory"                         [ [ object ] [ fixnum ] ] ]
     [ "die" "kernel"                          [ [ ] [ ] ] ]
+    [ "flush-icache" "assembler"              f ]
 ] [
     3unlist >r create >r 1 + r> 2dup swap f define r>
     dup string? [

library/compiler/xt.factor

@@ -1,46 +1,8 @@
-! :folding=indent:collapseFolds=1:
-
-! $Id$
-!
-! Copyright (C) 2004 Slava Pestov.
-! 
-! Redistribution and use in source and binary forms, with or without
-! modification, are permitted provided that the following conditions are met:
-! 
-! 1. Redistributions of source code must retain the above copyright notice,
-!    this list of conditions and the following disclaimer.
-! 
-! 2. Redistributions in binary form must reproduce the above copyright notice,
-!    this list of conditions and the following disclaimer in the documentation
-!    and/or other materials provided with the distribution.
-! 
-! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
-! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
-! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
-! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
-! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
-! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
-! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
-! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
-! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
-! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
+! Copyright (C) 2004, 2005 Slava Pestov.
+! See http://factor.sf.net/license.txt for BSD license.
 IN: compiler
-USE: assembler
-USE: inference
-USE: errors
-USE: hashtables
-USE: kernel
-USE: lists
-USE: math
-USE: namespaces
-USE: parser
-USE: prettyprint
-USE: stdio
-USE: strings
-USE: unparser
-USE: vectors
-USE: words
+USING: assembler errors kernel lists math namespaces strings
+words ;
 
 ! We use a hashtable "compiled-xts" that maps words to
 ! xt's that are currently being compiled. The commit-xt's word
@@ -60,6 +22,8 @@ SYMBOL: compiled-xts
     dup t "compiled" set-word-prop  set-word-xt ;
 
 : commit-xts ( -- )
+    #! We must flush the instruction cache on PowerPC.
+    flush-icache
     compiled-xts get [ unswons commit-xt ] each
     compiled-xts off ;
 

native/compiler.c

@@ -1,5 +1,11 @@
 #include "factor.h"
 
+void init_compiler(CELL size)
+{
+	init_zone(&compiling,size);
+	last_flush = compiling.base;
+}
+
 void primitive_compiled_offset(void)
 {
 	box_integer(compiling.here);
@@ -24,6 +30,12 @@ void primitive_set_literal_top(void)
 	literal_top = offset;
 }
 
+void primitive_flush_icache(void)
+{
+	flush_icache((void*)last_flush,compiling.here - last_flush);
+	last_flush = compiling.here;
+}
+
 void collect_literals(void)
 {
 	CELL i;

native/compiler.h

@@ -1,9 +1,9 @@
-/* The compiled code heap is structures into blocks. */
+/* The compiled code heap is structured into blocks. */
 typedef struct
 {
-	CELL header;
+	CELL header; /* = COMPILED_HEADER */
 	CELL code_length;
-	CELL reloc_length;
+	CELL reloc_length; /* see relocate.h */
 } F_COMPILED;
 
 #define COMPILED_HEADER 0x01c3babe
@@ -15,8 +15,19 @@ ZONE compiling;
 CELL literal_top;
 CELL literal_max;
 
+void init_compiler(CELL size);
 void primitive_compiled_offset(void);
 void primitive_set_compiled_offset(void);
 void primitive_literal_top(void);
 void primitive_set_literal_top(void);
 void collect_literals(void);
+
+#ifdef FACTOR_PPC
+extern void flush_icache(void *start, int len);
+#else
+INLINE void flush_icache(void *start, int len) {}
+#endif
+
+CELL last_flush;
+
+void primitive_flush_icache(void);

native/factor.c

@@ -3,6 +3,7 @@
 void init_factor(char* image)
 {
 	init_arena(DEFAULT_ARENA);
+	init_compiler(DEFAULT_ARENA);
 	load_image(image);
 	init_stacks();
 	init_io();

native/ffi.c

@@ -45,12 +45,12 @@ DLL* untag_dll(CELL tagged)
 	return (DLL*)UNTAG(tagged);
 }
 
-CELL unbox_alien(void)
+void* unbox_alien(void)
 {
 	return untag_alien(dpop())->ptr;
 }
 
-void box_alien(CELL ptr)
+void box_alien(void* ptr)
 {
 	ALIEN* alien = allot_object(ALIEN_TYPE,sizeof(ALIEN));
 	alien->ptr = ptr;
@@ -58,11 +58,11 @@ void box_alien(CELL ptr)
 	dpush(tag_object(alien));
 }
 
-INLINE CELL alien_pointer(void)
+INLINE void* alien_pointer(void)
 {
 	F_FIXNUM offset = unbox_integer();
 	ALIEN* alien = untag_alien(dpop());
-	CELL ptr = alien->ptr;
+	void* ptr = alien->ptr;
 
 	if(ptr == NULL)
 		general_error(ERROR_EXPIRED,tag_object(alien));
@@ -72,7 +72,7 @@ INLINE CELL alien_pointer(void)
 
 void primitive_alien(void)
 {
-	CELL ptr = unbox_integer();
+	void* ptr = (void*)unbox_integer();
 	maybe_garbage_collection();
 	box_alien(ptr);
 }
@@ -87,7 +87,7 @@ void primitive_local_alien(void)
 	maybe_garbage_collection();
 	alien = allot_object(ALIEN_TYPE,sizeof(ALIEN));
 	local = string(length / CHARS,'\0');
-	alien->ptr = (CELL)local + sizeof(F_STRING);
+	alien->ptr = (void*)(local + 1);
 	alien->local = true;
 	dpush(tag_object(alien));
 }
@@ -99,57 +99,57 @@ void primitive_local_alienp(void)
 
 void primitive_alien_address(void)
 {
-	box_cell(untag_alien(dpop())->ptr);
+	box_cell((CELL)untag_alien(dpop())->ptr);
 }
 
 void primitive_alien_cell(void)
 {
-	box_integer(get(alien_pointer()));
+	box_integer(*(int*)alien_pointer());
 }
 
 void primitive_set_alien_cell(void)
 {
-	CELL ptr = alien_pointer();
+	CELL* ptr = alien_pointer();
 	CELL value = unbox_integer();
-	put(ptr,value);
+	*ptr = value;
 }
 
 void primitive_alien_4(void)
 {
-	CELL ptr = alien_pointer();
-	box_integer(*(int*)ptr);
+	int* ptr = alien_pointer();
+	box_integer(*ptr);
 }
 
 void primitive_set_alien_4(void)
 {
-	CELL ptr = alien_pointer();
-	CELL value = unbox_integer();
-	*(int*)ptr = value;
+	int* ptr = alien_pointer();
+	int value = unbox_integer();
+	*ptr = value;
 }
 
 void primitive_alien_2(void)
 {
-	CELL ptr = alien_pointer();
-	box_signed_2(*(uint16_t*)ptr);
+	uint16_t* ptr = alien_pointer();
+	box_signed_2(*ptr);
 }
 
 void primitive_set_alien_2(void)
 {
-	CELL ptr = alien_pointer();
+	uint16_t* ptr = alien_pointer();
 	CELL value = unbox_signed_2();
-	*(uint16_t*)ptr = value;
+	*ptr = value;
 }
 
 void primitive_alien_1(void)
 {
-	box_signed_1(bget(alien_pointer()));
+	box_signed_1(*(BYTE*)alien_pointer());
 }
 
 void primitive_set_alien_1(void)
 {
-	CELL ptr = alien_pointer();
+	BYTE* ptr = alien_pointer();
 	BYTE value = value = unbox_signed_1();
-	bput(ptr,value);
+	*ptr = value;
 }
 
 void fixup_dll(DLL* dll)
@@ -174,6 +174,6 @@ void collect_alien(ALIEN* alien)
 	{
 		F_STRING* ptr = (F_STRING*)(alien->ptr - sizeof(F_STRING));
 		ptr = copy_untagged_object(ptr,SSIZE(ptr));
-		alien->ptr = (CELL)ptr + sizeof(F_STRING);
+		alien->ptr = (void*)(ptr + 1);
 	}
 }

native/ffi.h

@@ -10,7 +10,7 @@ DLL* untag_dll(CELL tagged);
 
 typedef struct {
 	CELL header;
-	CELL ptr;
+	void* ptr;
 	/* local aliens are heap-allocated as strings and must be collected. */
 	bool local;
 } ALIEN;
@@ -30,8 +30,8 @@ void primitive_dlsym(void);
 void primitive_dlclose(void);
 void primitive_alien(void);
 void primitive_local_alien(void);
-DLLEXPORT CELL unbox_alien(void);
-DLLEXPORT void box_alien(CELL ptr);
+DLLEXPORT void* unbox_alien(void);
+DLLEXPORT void box_alien(void* ptr);
 void primitive_local_alienp(void);
 void primitive_alien_address(void);
 void primitive_alien_cell(void);

native/icache.S

@@ -0,0 +1,34 @@
+/* Thanks to Joshua Grams for this code.
+
+On PowerPC processors, we must flush the instruction cache manually
+after writing to the code heap.
+
+Callable from C as
+void flush_icache(void *start, int len)
+
+This function is called from compiler.c. */
+
+#ifdef FACTOR_PPC
+
+/* IN: 3 = start, 4 = len */
+
+	.global _flush_icache
+_flush_icache:
+	/* compute number of cache lines to flush */
+	add 4,4,3
+	clrrwi 3,3,5    /* align addr to next lower cache line boundary */
+	sub 4,4,3       /* then n_lines = (len + 0x1f) / 0x20 */
+	addi 4,4,0x1f
+	srwi. 4,4,5     /* note '.' suffix */
+	beqlr           /* if n_lines == 0, just return. */
+	mtctr 4         /* flush cache lines */
+0:	dcbf 0,3        /* for each line... */
+	sync
+	icbi 0,3
+	addi 3,3,0x20
+	bdnz 0b
+	sync            /* finish up */
+	isync
+	blr
+
+#endif

native/memory.c

@@ -55,7 +55,6 @@ void init_arena(CELL size)
 {
 	init_zone(&active,size);
 	init_zone(&prior,size);
-	init_zone(&compiling,size);
 	allot_profiling = false;
 	gc_in_progress = false;
 	heap_scan = false;

native/primitives.c

@@ -172,7 +172,8 @@ void* primitives[] = {
 	primitive_next_object,
 	primitive_end_scan,
 	primitive_size,
-	primitive_die
+	primitive_die,
+	primitive_flush_icache
 };
 
 CELL primitive_to_xt(CELL primitive)