From 1abf62487d71a2eea968922f3715bc97efc6a832 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Wed, 1 Jun 2005 18:06:25 +0000
Subject: [PATCH] working on conditional fixnum vops for powerpc

---
 library/bootstrap/boot-stage2.factor    |  1 +
 library/compiler/ppc/assembler.factor   | 30 +++++++++--
 library/compiler/ppc/fixnum.factor      | 69 +++++++++++++++++++++++++
 library/compiler/ppc/generator.factor   |  4 +-
 library/compiler/ppc/stack.factor       |  6 ++-
 library/test/compiler/intrinsics.factor | 50 +++++++++---------
 native/cards.h                          | 13 +++--
 7 files changed, 135 insertions(+), 38 deletions(-)
 create mode 100644 library/compiler/ppc/fixnum.factor

diff --git a/library/bootstrap/boot-stage2.factor b/library/bootstrap/boot-stage2.factor
index 5220c94100..88fff4f63d 100644
--- a/library/bootstrap/boot-stage2.factor
+++ b/library/bootstrap/boot-stage2.factor
@@ -69,6 +69,7 @@ cpu "ppc" = [
     "/library/compiler/ppc/generator.factor"
     "/library/compiler/ppc/slots.factor"
     "/library/compiler/ppc/stack.factor"
+    "/library/compiler/ppc/fixnum.factor"
     "/library/compiler/ppc/alien.factor"
 ] pull-in
 
diff --git a/library/compiler/ppc/assembler.factor b/library/compiler/ppc/assembler.factor
index cebc93e086..0a43f981ae 100644
--- a/library/compiler/ppc/assembler.factor
+++ b/library/compiler/ppc/assembler.factor
@@ -30,8 +30,8 @@ USING: compiler errors kernel math memory words ;
     >r 1 shift >r 6 shift >r 11 shift >r 16 shift >r 21 shift
     r> bitor r> bitor r> bitor r> bitor r> bitor ;
 
-: x-form ( s a b xo rc -- n )
-    >r 1 shift >r 11 shift >r 16 shift >r 21 shift
+: x-form ( a s b xo rc -- n )
+    >r 1 shift >r 11 shift >r swap 16 shift >r 21 shift
     r> bitor r> bitor r> bitor r> bitor ;
 
 : xfx-form ( d spr xo -- n )
@@ -69,7 +69,7 @@ USING: compiler errors kernel math memory words ;
 : ANDI d-form 28 insn ;
 : ANDIS d-form 29 insn ;
 
-: (AND) 31 swap x-form 31 insn ;
+: (AND) 28 swap x-form 31 insn ;
 : AND 0 (AND) ;
 : AND. 0 (AND) ;
 
@@ -97,6 +97,9 @@ USING: compiler errors kernel math memory words ;
 : NOR 0 (NOR) ;
 : NOR. 1 (NOR) ;
 
+: NOT over NOR ;
+: NOT. over NOR. ;
+
 : ORI d-form 24 insn ;
 : ORIS d-form 25 insn ;
 
@@ -125,6 +128,24 @@ USING: compiler errors kernel math memory words ;
 
 : SRAWI 824 0 x-form 31 insn ;
 
+: (SUBF) 40 swap xo-form 31 insn ;
+: SUBF 0 0 (SUBF) ;
+: SUBF. 0 1 (SUBF) ;
+: SUBFO 1 0 (SUBF) ;
+: SUBFO. 1 1 (SUBF) ;
+
+: (SUBFC) 8 swap xo-form 31 insn ;
+: SUBFC 0 0 (SUBFC) ;
+: SUBFC. 0 1 (SUBFC) ;
+: SUBFCO 1 0 (SUBFC) ;
+: SUBFCO. 1 1 (SUBFC) ;
+
+: (SUBFE) 136 swap xo-form 31 insn ;
+: SUBFE 0 0 (SUBFE) ;
+: SUBFE. 0 1 (SUBFE) ;
+: SUBFEO 1 0 (SUBFE) ;
+: SUBFEO. 1 1 (SUBFE) ;
+
 : XORI d-form 26 insn ;
 : XORIS d-form 27 insn ;
 
@@ -161,7 +182,10 @@ GENERIC: BC
 M: integer BC 0 0 b-form 16 insn ;
 M: word BC >r 0 BC r> relative-14 ;
 
+: BLT 12 0 rot BC ;  : BGE 4 0 rot BC ;
+: BGT 12 1 rot BC ;  : BLE 4 1 rot BC ;
 : BEQ 12 2 rot BC ;  : BNE 4 2 rot BC ;
+: BO  12 3 rot BC ;  : BNO 4 3 rot BC ;
 
 : BCLR 0 8 0 0 b-form 19 insn ;
 : BLR 20 BCLR ;
diff --git a/library/compiler/ppc/fixnum.factor b/library/compiler/ppc/fixnum.factor
new file mode 100644
index 0000000000..d3729e28f0
--- /dev/null
+++ b/library/compiler/ppc/fixnum.factor
@@ -0,0 +1,69 @@
+! Copyright (C) 2005 Slava Pestov.
+! See http://factor.sf.net/license.txt for BSD license.
+IN: compiler-backend
+USING: assembler compiler kernel math memory namespaces words ;
+
+: maybe-immediate ( vop imm comp -- )
+    pick vop-in-1 integer? [
+        >r >r dest/src dupd r> execute r> drop
+    ] [
+        >r >r dest/src over r> drop r> execute
+    ] ifte ; inline
+
+M: %fixnum+ generate-node ( vop -- )
+    \ ADDI \ ADD maybe-immediate ;
+
+M: %fixnum- generate-node ( vop -- )
+    \ SUBI \ SUBF maybe-immediate ;
+
+M: %fixnum-bitand generate-node ( vop -- )
+    \ ANDI \ AND maybe-immediate ;
+
+M: %fixnum-bitor generate-node ( vop -- )
+    \ ORI \ OR maybe-immediate ;
+
+M: %fixnum-bitxor generate-node ( vop -- )
+    \ XORI \ XOR maybe-immediate ;
+
+M: %fixnum-bitnot generate-node ( vop -- )
+    dup vop-in-1 swap vop-out-1 NOT ;
+
+M: %fixnum<< generate-node ( vop -- )
+    dup vop-in-1 20 LI
+    dup vop-out-1 v>operand swap vop-in-2 v>operand 20 SLW ;
+
+M: %fixnum>> generate-node ( vop -- )
+    dup vop-out-1 v>operand over vop-in-2 v>operand
+    rot vop-in-1 >r 2dup r> SRAWI untag ;
+
+: load-boolean ( dest cond -- )
+    #! Compile this after a conditional jump to store f or t
+    #! in dest depending on the jump being taken or not.
+    <label> "true" set
+    <label> "end" set
+    "true" get swap execute
+    f address over LI
+    "end" get B
+    "true" get save-xt
+    t load-indirect
+    "end" get save-xt ; inline
+
+: fixnum-compare ( vop -- dest )
+    dup vop-out-1 v>operand
+    dup rot vop-in-1 v>operand
+    0 swap CMP ;
+
+M: %fixnum< generate-node ( vop -- )
+    fixnum-compare  \ BLT load-boolean ;
+
+M: %fixnum<= generate-node ( vop -- )
+    fixnum-compare  \ BLE load-boolean ;
+
+M: %fixnum> generate-node ( vop -- )
+    fixnum-compare  \ BGT load-boolean ;
+
+M: %fixnum>= generate-node ( vop -- )
+    fixnum-compare  \ BGE load-boolean ;
+
+M: %eq? generate-node ( vop -- )
+    fixnum-compare  \ BEQ load-boolean ;
diff --git a/library/compiler/ppc/generator.factor b/library/compiler/ppc/generator.factor
index a3df52edd2..dea0615e78 100644
--- a/library/compiler/ppc/generator.factor
+++ b/library/compiler/ppc/generator.factor
@@ -76,8 +76,10 @@ M: %return-to generate-node ( vop -- )
 M: %return generate-node ( vop -- )
     drop compile-epilogue BLR ;
 
+: untag ( dest src -- ) 0 0 28 RLWINM ;
+
 M: %untag generate-node ( vop -- )
-    dest/src 0 0 28 RLWINM ;
+    dest/src untag ;
 
 M: %untag-fixnum generate-node ( vop -- )
     dest/src tag-bits SRAWI ;
diff --git a/library/compiler/ppc/stack.factor b/library/compiler/ppc/stack.factor
index 0e8cf116f6..de14a5afb3 100644
--- a/library/compiler/ppc/stack.factor
+++ b/library/compiler/ppc/stack.factor
@@ -9,9 +9,11 @@ USING: assembler compiler errors kernel math memory words ;
 M: %immediate generate-node ( vop -- )
     dup vop-in-1 address swap vop-out-1 v>operand LOAD32 ;
 
+: load-indirect ( dest literal -- )
+    intern-literal over LOAD dup 0 LWZ ;
+
 M: %indirect generate-node ( vop -- )
-    dup vop-out-1 v>operand swap vop-in-1 intern-literal
-    over LOAD dup 0 LWZ ;
+    dup vop-out-1 v>operand swap vop-in-1 load-indirect ;
 
 M: %peek-d generate-node ( vop -- )
     dup vop-out-1 v>operand swap vop-in-1 ds-op LWZ ;
diff --git a/library/test/compiler/intrinsics.factor b/library/test/compiler/intrinsics.factor
index 939be1359e..83ab847757 100644
--- a/library/test/compiler/intrinsics.factor
+++ b/library/test/compiler/intrinsics.factor
@@ -51,31 +51,6 @@ math-internals test words ;
 [ 11 ] [ 12 [ 7 fixnum-bitxor ] compile-1 ] unit-test
 [ 11 ] [ [ 12 7 fixnum-bitxor ] compile-1 ] unit-test
 
-[ HEX: 10000000 ] [ HEX: -10000000 >fixnum [ 0 swap fixnum- ] compile-1 ] unit-test
-[ HEX: 10000000 ] [ HEX: -fffffff >fixnum [ 1 swap fixnum- ] compile-1 ] unit-test
-
-[ 4294967296 ] [ 1 32 [ fixnum-shift ] compile-1 ] unit-test
-[ 4294967296 ] [ 1 [ 32 fixnum-shift ] compile-1 ] unit-test
-[ 4294967296 ] [ 1 [ 16 fixnum-shift 16 fixnum-shift ] compile-1 ] unit-test
-[ -4294967296 ] [ -1 32 [ fixnum-shift ] compile-1 ] unit-test
-[ -4294967296 ] [ -1 [ 32 fixnum-shift ] compile-1 ] unit-test
-[ -4294967296 ] [ -1 [ 16 fixnum-shift 16 fixnum-shift ] compile-1 ] unit-test
-
-[ 8 ] [ 1 3 [ fixnum-shift ] compile-1 ] unit-test
-[ 8 ] [ 1 [ 3 fixnum-shift ] compile-1 ] unit-test
-[ 8 ] [ [ 1 3 fixnum-shift ] compile-1 ] unit-test
-[ -8 ] [ -1 3 [ fixnum-shift ] compile-1 ] unit-test
-[ -8 ] [ -1 [ 3 fixnum-shift ] compile-1 ] unit-test
-[ -8 ] [ [ -1 3 fixnum-shift ] compile-1 ] unit-test
-
-[ 2 ] [ 8 -2 [ fixnum-shift ] compile-1 ] unit-test
-[ 2 ] [ 8 [ -2 fixnum-shift ] compile-1 ] unit-test
-
-[ 0 ] [ [ 123 -64 fixnum-shift ] compile-1 ] unit-test
-[ 0 ] [ 123 -64 [ fixnum-shift ] compile-1 ] unit-test
-[ -1 ] [ [ -123 -64 fixnum-shift ] compile-1 ] unit-test
-[ -1 ] [ -123 -64 [ fixnum-shift ] compile-1 ] unit-test
-
 [ f ] [ 12 7 [ fixnum< ] compile-1 ] unit-test
 [ f ] [ 12 [ 7 fixnum< ] compile-1 ] unit-test
 [ f ] [ [ 12 7 fixnum< ] compile-1 ] unit-test
@@ -122,6 +97,31 @@ math-internals test words ;
 [ -1 ] [ 0 [ fixnum-bitnot ] compile-1 ] unit-test
 [ -1 ] [ [ 0 fixnum-bitnot ] compile-1 ] unit-test
 
+[ HEX: 10000000 ] [ HEX: -10000000 >fixnum [ 0 swap fixnum- ] compile-1 ] unit-test
+[ HEX: 10000000 ] [ HEX: -fffffff >fixnum [ 1 swap fixnum- ] compile-1 ] unit-test
+
+[ 4294967296 ] [ 1 32 [ fixnum-shift ] compile-1 ] unit-test
+[ 4294967296 ] [ 1 [ 32 fixnum-shift ] compile-1 ] unit-test
+[ 4294967296 ] [ 1 [ 16 fixnum-shift 16 fixnum-shift ] compile-1 ] unit-test
+[ -4294967296 ] [ -1 32 [ fixnum-shift ] compile-1 ] unit-test
+[ -4294967296 ] [ -1 [ 32 fixnum-shift ] compile-1 ] unit-test
+[ -4294967296 ] [ -1 [ 16 fixnum-shift 16 fixnum-shift ] compile-1 ] unit-test
+
+[ 8 ] [ 1 3 [ fixnum-shift ] compile-1 ] unit-test
+[ 8 ] [ 1 [ 3 fixnum-shift ] compile-1 ] unit-test
+[ 8 ] [ [ 1 3 fixnum-shift ] compile-1 ] unit-test
+[ -8 ] [ -1 3 [ fixnum-shift ] compile-1 ] unit-test
+[ -8 ] [ -1 [ 3 fixnum-shift ] compile-1 ] unit-test
+[ -8 ] [ [ -1 3 fixnum-shift ] compile-1 ] unit-test
+
+[ 2 ] [ 8 -2 [ fixnum-shift ] compile-1 ] unit-test
+[ 2 ] [ 8 [ -2 fixnum-shift ] compile-1 ] unit-test
+
+[ 0 ] [ [ 123 -64 fixnum-shift ] compile-1 ] unit-test
+[ 0 ] [ 123 -64 [ fixnum-shift ] compile-1 ] unit-test
+[ -1 ] [ [ -123 -64 fixnum-shift ] compile-1 ] unit-test
+[ -1 ] [ -123 -64 [ fixnum-shift ] compile-1 ] unit-test
+
 [ 3 ] [ 13 10 [ fixnum-mod ] compile-1 ] unit-test
 [ 3 ] [ 13 [ 10 fixnum-mod ] compile-1 ] unit-test
 [ 3 ] [ [ 13 10 fixnum-mod ] compile-1 ] unit-test
diff --git a/native/cards.h b/native/cards.h
index 94f97f73fc..ef979d9249 100644
--- a/native/cards.h
+++ b/native/cards.h
@@ -13,12 +13,7 @@ the offset of the first object is set by the allocator.
 #define CARD_BASE_MASK 0x7f
 typedef u8 CARD;
 
-#ifdef FACTOR_PPC
-	register CARD *cards asm("r16");
-#else
-	CARD *cards;
-#endif
-
+CARD *cards;
 CARD *cards_end;
 
 /* A card is 16 bytes (128 bits), 5 address bits per card.
@@ -48,7 +43,11 @@ INLINE u8 card_base(CARD c)
 	return c & CARD_BASE_MASK;
 }
 
-CELL cards_offset;
+#ifdef FACTOR_PPC
+	register CELL cards_offset asm("r16");
+#else
+	CELL cards_offset;
+#endif
 
 #define ADDR_TO_CARD(a) (CARD*)(((CELL)a >> CARD_BITS) + cards_offset)
 #define CARD_TO_ADDR(c) (CELL*)(((CELL)c - cards_offset)<<CARD_BITS)