From e7cd1e2ce285b05be14f7e393dae6eb1ee491a53 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Sat, 29 Sep 2007 23:57:29 -0400
Subject: [PATCH] Fix some stuff in cpu/ppc, fix bootstrap bug

---
 core/alien/alien-tests.factor             |  4 ++++
 core/cpu/ppc/allot/allot.factor           |  3 +--
 core/cpu/ppc/intrinsics/intrinsics.factor |  4 ++--
 core/generator/registers/registers.factor |  2 +-
 vm/alien.c                                | 19 ++++++++++++++++---
 5 files changed, 24 insertions(+), 8 deletions(-)

diff --git a/core/alien/alien-tests.factor b/core/alien/alien-tests.factor
index c84a745795..ca475bf80a 100644
--- a/core/alien/alien-tests.factor
+++ b/core/alien/alien-tests.factor
@@ -57,6 +57,10 @@ cell 8 = [
 
 [ "ALIEN: 1234" ] [ 1234 <alien> unparse ] unit-test
 
+[ ] [ 0 B{ 1 2 3 } <displaced-alien> drop ] unit-test
+[ ] [ 0 F{ 1 2 3 } <displaced-alien> drop ] unit-test
+[ ] [ 0 ?{ t f t } <displaced-alien> drop ] unit-test
+
 [ 0 B{ 1 2 3 } <displaced-alien> alien-address ] unit-test-fails
 
 [ 1 1 <displaced-alien> ] unit-test-fails
diff --git a/core/cpu/ppc/allot/allot.factor b/core/cpu/ppc/allot/allot.factor
index 872ffd794c..66b03c6018 100644
--- a/core/cpu/ppc/allot/allot.factor
+++ b/core/cpu/ppc/allot/allot.factor
@@ -79,8 +79,7 @@ M: ppc-backend %box-float ( dst src -- )
     ] with-scope ;
 
 M: ppc-backend %box-alien ( dst src -- )
-    "f" define-label
-    "end" define-label
+    { "end" "f" } [ define-label ] each
     0 over v>operand 0 CMPI
     "f" get BEQ
     alien 4 cells %allot
diff --git a/core/cpu/ppc/intrinsics/intrinsics.factor b/core/cpu/ppc/intrinsics/intrinsics.factor
index 6a7aa33cbe..25d7128e21 100644
--- a/core/cpu/ppc/intrinsics/intrinsics.factor
+++ b/core/cpu/ppc/intrinsics/intrinsics.factor
@@ -690,8 +690,8 @@ define-alien-integer-intrinsics
             { unboxed-c-ptr "alien" simple-c-ptr }
             { f "offset" fixnum }
         } }
-        { +scratch+ { { float "output" } } }
-        { +output+ { "output" } }
+        { +scratch+ { { float "value" } } }
+        { +output+ { "value" } }
         { +clobber+ { "offset" } }
     } ;
 
diff --git a/core/generator/registers/registers.factor b/core/generator/registers/registers.factor
index ac4dd53fbc..73029bf1e2 100644
--- a/core/generator/registers/registers.factor
+++ b/core/generator/registers/registers.factor
@@ -114,7 +114,7 @@ M: cached live-loc? cached-loc live-loc? ;
 M: cached (lazy-load) >r cached-vreg r> (lazy-load) ;
 M: cached lazy-store
     2dup cached-loc =
-    [ 2drop f ] [ "live-locs" get at %move ] if ;
+    [ 2drop ] [ "live-locs" get at %move ] if ;
 M: cached minimal-ds-loc* cached-loc minimal-ds-loc* ;
 
 INSTANCE: cached value
diff --git a/vm/alien.c b/vm/alien.c
index 18f81f0acf..93c9948fda 100644
--- a/vm/alien.c
+++ b/vm/alien.c
@@ -78,13 +78,26 @@ void box_alien(void *ptr)
 DEFINE_PRIMITIVE(displaced_alien)
 {
 	CELL alien = dpop();
-	if(type_of(alien) != F_TYPE && type_of(alien) != ALIEN_TYPE)
-		type_error(ALIEN_TYPE,alien);
 	CELL displacement = to_cell(dpop());
+
 	if(alien == F && displacement == 0)
 		dpush(F);
 	else
-		dpush(allot_alien(alien,displacement));
+	{
+		switch(type_of(alien))
+		{
+		case BYTE_ARRAY_TYPE:
+		case BIT_ARRAY_TYPE:
+		case FLOAT_ARRAY_TYPE:
+		case ALIEN_TYPE:
+		case F_TYPE:
+			dpush(allot_alien(alien,displacement));
+			break;
+		default:
+			type_error(ALIEN_TYPE,alien);
+			break;
+		}
+	}
 }
 
 /* address of an object representing a C pointer. Explicitly throw an error