register declarations for powerpc

TODO.FACTOR.txt

@@ -11,9 +11,6 @@
 - print warning on null class
 - optimize away dispatch
 
-- move tuple to generic vocab
-
-- vectors: ensure its ok with bignum indices
 - code gc
 - ppc register decls
 
@@ -50,6 +47,7 @@
 
 + kernel:
 
+- vectors: ensure its ok with bignum indices
 - cat, reverse-cat primitives
 - generational gc
 - make see work with union, builtin, predicate
@@ -57,3 +55,4 @@
 - proper ordering for classes
 - make-vector and make-string should not need a reverse step
 - worddef props
+- automatically recompiling defs

library/generic/tuple.factor

@@ -4,6 +4,8 @@ IN: generic
 USING: words parser kernel namespaces lists strings
 kernel-internals math hashtables errors vectors ;
 
+BUILTIN: tuple 18
+
 : class ( obj -- class )
     #! The class of an object.
     dup tuple? [ 2 slot ] [ type builtin-type ] ifte ;

library/kernel.factor

@@ -7,8 +7,6 @@ IN: kernel-internals USING: generic kernel vectors ;
     #! call it directly.
     vector-array array-nth call ;
 
-BUILTIN: tuple 18
-
 IN: kernel
 
 GENERIC: hashcode ( obj -- n )

library/ui/buttons.factor

@@ -3,6 +3,9 @@
 IN: gadgets
 USING: generic kernel lists math namespaces sdl ;
 
+: button-down? ( n -- ? )
+    my-hand hand-buttons contains? ;
+
 : button-pressed  ( button -- )
     dup f bevel-up? set-paint-property redraw ;
 

library/ui/gestures.factor

@@ -76,6 +76,3 @@ SYMBOL: button-down
     [
         2dup child? [ gain-focus ] hierarchy-gesture
     ] each-parent 2drop ;
-
-: button-down? ( n -- ? )
-    my-hand hand-buttons contains? ;

native/array.c

@@ -100,5 +100,5 @@ void collect_array(F_ARRAY* array)
 	int i = 0;
 	CELL capacity = untag_fixnum_fast(array->capacity);
 	for(i = 0; i < capacity; i++)
-		copy_object((void*)AREF(array,i));
+		copy_handle((void*)AREF(array,i));
 }

native/bignum.c

@@ -240,7 +240,7 @@ void primitive_bignum_not(void)
 
 void copy_bignum_constants(void)
 {
-	copy_object(&bignum_zero);
+	COPY_OBJECT(bignum_zero);
-	copy_object(&bignum_pos_one);
+	COPY_OBJECT(bignum_pos_one);
-	copy_object(&bignum_neg_one);
+	COPY_OBJECT(bignum_neg_one);
 }

native/compiler.c

@@ -28,5 +28,5 @@ void collect_literals(void)
 {
 	CELL i;
 	for(i = compiling.base; i < literal_top; i += CELLS)
-		copy_object((CELL*)i);
+		copy_handle((CELL*)i);
 }

native/factor.h

@@ -3,6 +3,8 @@
 
 #if defined(i386) || defined(__i386) || defined(__i386__) || defined(WIN32)
     #define FACTOR_X86
+#elif defined(__POWERPC__) || defined(__ppc__) || defined(_ARCH_PPC)
+    #define FACTOR_PPC
 #endif
 
 #if defined(WIN32)
@@ -19,8 +21,10 @@ typedef unsigned long int CELL;
 CELL ds_bot;
 
 /* raw pointer to datastack top */
-#ifdef FACTOR_X86
+#if defined(FACTOR_X86)
 	register CELL ds asm("esi");
+#elif defined(FACTOR_PPC)
+	register CELL ds asm("r14");
 #else
 	CELL ds;
 #endif
@@ -29,10 +33,25 @@ CELL ds_bot;
 CELL cs_bot;
 
 /* raw pointer to callstack top */
+#if defined(FACTOR_PPC)
+	register CELL cs asm("r15");
+#else
 	DLLEXPORT CELL cs;
+#endif
 
 /* TAGGED currently executing quotation */
+#if defined(FACTOR_PPC)
+	register CELL callframe asm("r16");
+#else
 	CELL callframe;
+#endif
+
+/* TAGGED pointer to currently executing word */
+#if defined(FACTOR_PPC)
+	register CELL executing asm("r17");
+#else
+	CELL executing;
+#endif
 
 #include <errno.h>
 #include <fcntl.h>

native/ffi.c

@@ -160,7 +160,7 @@ void fixup_dll(DLL* dll)
 
 void collect_dll(DLL* dll)
 {
-	copy_object(&dll->path);
+	COPY_OBJECT(dll->path);
 }
 
 void fixup_alien(ALIEN* alien)

native/gc.c

@@ -17,20 +17,20 @@ void collect_roots(void)
 	CELL ptr;
 
 	/*T must be the first in the heap */
-	copy_object(&T);
+	COPY_OBJECT(T);
 	/* the bignum 0 1 -1 constants must be the next three */
 	copy_bignum_constants();
-	copy_object(&callframe);
+	COPY_OBJECT(callframe);
-	copy_object(&executing);
+	COPY_OBJECT(executing);
 
 	for(ptr = ds_bot; ptr <= ds; ptr += CELLS)
-		copy_object((void*)ptr);
+		copy_handle((CELL*)ptr);
 
 	for(ptr = cs_bot; ptr <= cs; ptr += CELLS)
-		copy_object((void*)ptr);
+		copy_handle((CELL*)ptr);
 
 	for(i = 0; i < USER_ENV; i++)
-		copy_object(&userenv[i]);
+		copy_handle(&userenv[i]);
 }
 
 /*
@@ -106,7 +106,7 @@ INLINE CELL collect_next(CELL scan)
 	else
 	{
 		size = CELLS;
-		copy_object((CELL*)scan);
+		copy_handle((CELL*)scan);
 	}
 
 	return scan + size;

native/gc.h

@@ -16,30 +16,31 @@ INLINE void* copy_untagged_object(void* pointer, CELL size)
 
 CELL copy_object_impl(CELL pointer);
 
-INLINE void copy_object(CELL* handle)
+INLINE CELL copy_object(CELL pointer)
 {
-	CELL pointer = *handle;
 	CELL tag;
 	CELL header;
-	CELL newpointer;
 
 	if(pointer == F)
-		return;
+		return F;
 
 	tag = TAG(pointer);
 
 	if(tag == FIXNUM_TYPE)
-		return;
+		return pointer;
-
-	if(headerp(pointer))
-		critical_error("Asked to copy header",pointer);
 
 	header = get(UNTAG(pointer));
 	if(TAG(header) == GC_COLLECTED)
-		newpointer = UNTAG(header);
+		return RETAG(UNTAG(header),tag);
 	else
-		newpointer = copy_object_impl(pointer);
+		return RETAG(copy_object_impl(pointer),tag);
-	*handle = RETAG(newpointer,tag);
+}
+
+#define COPY_OBJECT(lvalue) lvalue = copy_object(lvalue)
+
+INLINE void copy_handle(CELL* handle)
+{
+	COPY_OBJECT(*handle);
 }
 
 void collect_roots(void);

native/hashtable.c

@@ -29,5 +29,5 @@ void fixup_hashtable(F_HASHTABLE* hashtable)
 
 void collect_hashtable(F_HASHTABLE* hashtable)
 {
-	copy_object(&hashtable->array);
+	COPY_OBJECT(hashtable->array);
 }

native/port.c

@@ -57,11 +57,11 @@ void fixup_port(F_PORT* port)
 
 void collect_port(F_PORT* port)
 {
-	copy_object(&port->buffer);
+	COPY_OBJECT(port->buffer);
-	copy_object(&port->line);
+	COPY_OBJECT(port->line);
-	copy_object(&port->client_host);
+	COPY_OBJECT(port->client_host);
-	copy_object(&port->client_port);
+	COPY_OBJECT(port->client_port);
-	copy_object(&port->io_error);
+	COPY_OBJECT(port->io_error);
 }
 
 #ifdef WIN32

native/run.h

@@ -26,9 +26,6 @@ jmp_buf toplevel;
 sigjmp_buf toplevel;
 #endif
 
-/* TAGGED pointer to currently executing word */
-CELL executing;
-
 /* TAGGED user environment data; see getenv/setenv prims */
 CELL userenv[USER_ENV];
 

native/sbuf.c

@@ -190,5 +190,5 @@ void fixup_sbuf(F_SBUF* sbuf)
 
 void collect_sbuf(F_SBUF* sbuf)
 {
-	copy_object(&sbuf->string);
+	COPY_OBJECT(sbuf->string);
 }

native/unix/io.c

@@ -291,13 +291,13 @@ void collect_io_tasks(void)
 
 	for(i = 0; i < FD_SETSIZE; i++)
 	{
-		copy_object(&read_io_tasks[i].port);
+		COPY_OBJECT(read_io_tasks[i].port);
-		copy_object(&read_io_tasks[i].callbacks);
+		COPY_OBJECT(read_io_tasks[i].callbacks);
 	}
 
 	for(i = 0; i < FD_SETSIZE; i++)
 	{
-		copy_object(&write_io_tasks[i].port);
+		COPY_OBJECT(write_io_tasks[i].port);
-		copy_object(&write_io_tasks[i].callbacks);
+		COPY_OBJECT(write_io_tasks[i].callbacks);
 	}
 }

native/vector.c

@@ -29,5 +29,5 @@ void fixup_vector(F_VECTOR* vector)
 
 void collect_vector(F_VECTOR* vector)
 {
-	copy_object(&vector->array);
+	COPY_OBJECT(vector->array);
 }

native/word.c

@@ -57,6 +57,6 @@ void fixup_word(F_WORD* word)
 
 void collect_word(F_WORD* word)
 {
-	copy_object(&word->parameter);
+	COPY_OBJECT(word->parameter);
-	copy_object(&word->plist);
+	COPY_OBJECT(word->plist);
 }