From 3f20042a03c19b898251e7a083f61bb0c2cac7ee Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Sat, 10 Sep 2005 06:56:33 +0000
Subject: [PATCH] fix naming clash, remove %tag-fixnum %untag-fixnum %jump-f
 vops

---
 library/compiler/intrinsics.factor      | 10 +++---
 library/compiler/linearizer.factor      |  1 -
 library/compiler/ppc/generator.factor   | 15 +--------
 library/compiler/vops.factor            | 21 ++-----------
 library/compiler/x86/generator.factor   | 41 ++++++++++---------------
 library/test/compiler/intrinsics.factor |  6 ----
 library/test/compiler/optimizer.factor  |  6 ++++
 7 files changed, 31 insertions(+), 69 deletions(-)

diff --git a/library/compiler/intrinsics.factor b/library/compiler/intrinsics.factor
index 6201021a6d..21e4c44829 100644
--- a/library/compiler/intrinsics.factor
+++ b/library/compiler/intrinsics.factor
@@ -63,7 +63,6 @@ sequences vectors words ;
     drop
     in-1
     0 %type ,
-    0 %retag-fixnum ,
     out-1
 ] "intrinsic" set-word-prop
 
@@ -71,7 +70,6 @@ sequences vectors words ;
     drop
     in-1
     0 %tag ,
-    0 %retag-fixnum ,
     out-1
 ] "intrinsic" set-word-prop
 
@@ -164,7 +162,7 @@ sequences vectors words ;
     in-2
     -1 %inc-d ,
     1 <vreg> 0 <vreg> 2 <vreg> %fixnum-mod ,
-    2 0 %replace-d ,
+    << vreg f 2 >> 0 %replace-d ,
 ] "intrinsic" set-word-prop
 
 \ fixnum/mod [
@@ -174,8 +172,8 @@ sequences vectors words ;
     { << vreg f 1 >> << vreg f 0 >> }
     { << vreg f 2 >> << vreg f 0 >> }
     %fixnum/mod ,
-    2 0 %replace-d ,
-    0 1 %replace-d ,
+    << vreg f 2 >> 0 %replace-d ,
+    << vreg f 0 >> 1 %replace-d ,
 ] "intrinsic" set-word-prop
 
 \ fixnum-bitnot [
@@ -213,7 +211,7 @@ sequences vectors words ;
     in-1
     dup cell -8 * <= [
         drop 0 <vreg> 2 <vreg> %fixnum-sgn ,
-        2 0 %replace-d ,
+        << vreg f 2 >> 0 %replace-d ,
     ] [
         neg 0 <vreg> 0 <vreg> %fixnum>> ,
         out-1
diff --git a/library/compiler/linearizer.factor b/library/compiler/linearizer.factor
index 9bb95fb7d7..5813bf6e20 100644
--- a/library/compiler/linearizer.factor
+++ b/library/compiler/linearizer.factor
@@ -72,7 +72,6 @@ M: #ifte linearize* ( node -- )
     #! label/branch pairs.
     in-1
     -1 %inc-d ,
-    0 %untag-fixnum ,
     0 %dispatch ,
     [ <label> dup %target-label ,  cons ] map
     %end-dispatch , ;
diff --git a/library/compiler/ppc/generator.factor b/library/compiler/ppc/generator.factor
index 098532eb99..63520fa213 100644
--- a/library/compiler/ppc/generator.factor
+++ b/library/compiler/ppc/generator.factor
@@ -52,14 +52,8 @@ M: %jump generate-node ( vop -- )
 M: %jump-label generate-node ( vop -- )
     vop-label B ;
 
-: conditional ( vop -- label )
-    dup 0 vop-in v>operand 0 swap f address CMPI vop-label ;
-
-M: %jump-f generate-node ( vop -- )
-    conditional BEQ ;
-
 M: %jump-t generate-node ( vop -- )
-    conditional BNE ;
+    dup 0 vop-in v>operand 0 swap f address CMPI vop-label BNE ;
 
 M: %return-to generate-node ( vop -- )
     vop-label 0 3 LOAD32  absolute-16/16
@@ -74,15 +68,8 @@ M: %return generate-node ( vop -- )
 M: %untag generate-node ( vop -- )
     dest/src untag ;
 
-M: %untag-fixnum generate-node ( vop -- )
-    dest/src tag-bits SRAWI ;
-
 : tag-fixnum ( src dest -- ) tag-bits SLWI ;
 
-M: %retag-fixnum generate-node ( vop -- )
-    ! todo: formalize scratch register usage
-    dest/src tag-fixnum ;
-
 M: %dispatch generate-node ( vop -- )
     0 <vreg> check-src
     3 3 2 SLWI
diff --git a/library/compiler/vops.factor b/library/compiler/vops.factor
index 948416cbda..4c7b0dedfb 100644
--- a/library/compiler/vops.factor
+++ b/library/compiler/vops.factor
@@ -101,10 +101,6 @@ TUPLE: %jump-t ;
 C: %jump-t make-vop ;
 : %jump-t <vreg> label/src-vop <%jump-t> ;
 
-TUPLE: %jump-f ;
-C: %jump-f make-vop ;
-: %jump-f <vreg> label/src-vop <%jump-f> ;
-
 ! dispatch tables
 TUPLE: %dispatch ;
 C: %dispatch make-vop ;
@@ -135,7 +131,7 @@ TUPLE: %replace-d ;
 C: %replace-d make-vop ;
 
 : %replace-d ( vreg n -- vop )
-    <ds-loc> swap <vreg> swap src/dest-vop <%replace-d> ;
+    <ds-loc> src/dest-vop <%replace-d> ;
 
 M: %replace-d basic-block? drop t ;
 
@@ -165,7 +161,7 @@ TUPLE: %replace-r ;
 C: %replace-r make-vop ;
 
 : %replace-r ( vreg n -- vop )
-    <cs-loc> swap <vreg> swap src/dest-vop <%replace-r> ;
+    <cs-loc> src/dest-vop <%replace-r> ;
 
 M: %replace-r basic-block? drop t ;
 
@@ -180,7 +176,7 @@ M: %inc-r basic-block? drop t ;
 : in-1 0 0 %peek-d , ;
 : in-2 0 1 %peek-d ,  1 0 %peek-d , ;
 : in-3 0 2 %peek-d ,  1 1 %peek-d ,  2 0 %peek-d , ;
-: out-1 0 0 %replace-d , ;
+: out-1 << vreg f 0 >> 0 %replace-d , ;
 
 ! indirect load of a literal through a table
 TUPLE: %indirect ;
@@ -190,7 +186,6 @@ C: %indirect make-vop ;
 M: %indirect basic-block? drop t ;
 
 ! object slot accessors
-! mask off a tag (see also %untag-fixnum)
 TUPLE: %untag ;
 C: %untag make-vop ;
 : %untag <vreg> dest-vop <%untag> ;
@@ -314,16 +309,6 @@ C: %tag make-vop ;
 : %tag ( vreg ) <vreg> dest-vop <%tag> ;
 M: %tag basic-block? drop t ;
 
-TUPLE: %retag-fixnum ;
-C: %retag-fixnum make-vop ;
-: %retag-fixnum <vreg> dest-vop <%retag-fixnum> ;
-M: %retag-fixnum basic-block? drop t ;
-
-TUPLE: %untag-fixnum ;
-C: %untag-fixnum make-vop ;
-: %untag-fixnum <vreg> dest-vop <%untag-fixnum> ;
-M: %untag-fixnum basic-block? drop t ;
-
 : check-dest ( vop reg -- )
     swap 0 vop-out = [ "bad VOP destination" throw ] unless ;
 
diff --git a/library/compiler/x86/generator.factor b/library/compiler/x86/generator.factor
index 3e1a8f8805..7e756c24ea 100644
--- a/library/compiler/x86/generator.factor
+++ b/library/compiler/x86/generator.factor
@@ -22,14 +22,8 @@ M: %jump generate-node ( vop -- )
 M: %jump-label generate-node ( vop -- )
     vop-label JMP ;
 
-: conditional ( vop -- label )
-    dup 0 vop-in v>operand f address CMP vop-label ;
-
-M: %jump-f generate-node ( vop -- )
-    conditional JE ;
-
 M: %jump-t generate-node ( vop -- )
-    conditional JNE ;
+    dup 0 vop-in v>operand f address CMP vop-label JNE ;
 
 M: %return-to generate-node ( vop -- )
     0 PUSH vop-label absolute ;
@@ -37,22 +31,13 @@ M: %return-to generate-node ( vop -- )
 M: %return generate-node ( vop -- )
     drop RET ;
 
-M: %untag generate-node ( vop -- )
-    0 vop-out v>operand BIN: 111 bitnot AND ;
-
-M: %retag-fixnum generate-node ( vop -- )
-    0 vop-out v>operand 3 SHL ;
-
-M: %untag-fixnum generate-node ( vop -- )
-    0 vop-out v>operand 3 SHR ;
-
 M: %dispatch generate-node ( vop -- )
     #! Compile a piece of code that jumps to an offset in a
     #! jump table indexed by the fixnum at the top of the stack.
     #! The jump table must immediately follow this macro.
     0 vop-in v>operand
-    ! Multiply by 4 to get a jump table offset
-    dup 2 SHL
+    ! Untag and multiply by 4 to get a jump table offset
+    dup tag-bits 2 - SHR
     ! Add to jump table base
     dup HEX: ffff ADD  just-compiled >r 0 0 rel-address
     ! Jump to jump table entry
@@ -63,8 +48,8 @@ M: %dispatch generate-node ( vop -- )
     compiled-offset r> set-compiled-cell ( fixup -- ) ;
 
 M: %type generate-node ( vop -- )
-    #! Intrinstic version of type primitive. It outputs an
-    #! UNBOXED value in 0 vop-out.
+    #! Intrinstic version of type primitive.
+    <label> "header" set
     <label> "f" set
     <label> "end" set
     0 vop-out v>operand
@@ -75,21 +60,29 @@ M: %type generate-node ( vop -- )
     ! Compare with object tag number (3).
     dup object-tag CMP
     ! Jump if the object doesn't store type info in its header
-    "end" get JNE
+    "header" get JE
     ! It doesn't store type info in its header
+    dup tag-bits SHL
+    "end" get JMP
+    "header" get save-xt
     ! It does store type info in its header
     ! Is the pointer itself equal to 3? Then its F_TYPE (9).
     ECX object-tag CMP
     "f" get JE
     ! The pointer is not equal to 3. Load the object header.
     dup ECX object-tag neg 2list MOV
-    dup 3 SHR
+    ! Mask off header tag, making a fixnum.
+    dup object-tag XOR
     "end" get JMP
     "f" get save-xt
     ! The pointer is equal to 3. Load F_TYPE (9).
-    f type MOV
+    f type tag-bits shift MOV
     "end" get save-xt ;
 
 M: %tag generate-node ( vop -- )
     dup dup 0 vop-in check-dest
-    0 vop-in v>operand tag-mask AND ;
+    0 vop-in v>operand dup tag-mask AND
+    tag-bits SHL ;
+
+M: %untag generate-node ( vop -- )
+    0 vop-out v>operand tag-mask bitnot AND ;
diff --git a/library/test/compiler/intrinsics.factor b/library/test/compiler/intrinsics.factor
index d03c6f3b18..a0ca804017 100644
--- a/library/test/compiler/intrinsics.factor
+++ b/library/test/compiler/intrinsics.factor
@@ -170,9 +170,3 @@ math-internals test words ;
 
 ! regression
 [ t ] [ { 1 2 3 } { 1 2 3 } [ over type over type eq? ] compile-1 2nip ] unit-test
-
-! regression
-: bleh 3 ;
-: blah over cons? [ bleh >r 2cdr r> ] [ 2drop f f f ] ifte ; compiled
-
-[ f ] [ [ 1 2 3 ] [ 1 3 2 ] blah drop 2car = ] unit-test
diff --git a/library/test/compiler/optimizer.factor b/library/test/compiler/optimizer.factor
index 4949201085..f48faa276c 100644
--- a/library/test/compiler/optimizer.factor
+++ b/library/test/compiler/optimizer.factor
@@ -187,3 +187,9 @@ TUPLE: pred-test ;
 : bad-kill-2 bad-kill-1 drop ; compiled
 
 [ 3 ] [ t bad-kill-2 ] unit-test
+
+! regression
+: bleh 3 ;
+: blah over cons? [ bleh >r 2cdr r> ] [ 2drop f f f ] ifte ; compiled
+
+[ f ] [ [ 1 2 3 ] [ 1 3 2 ] blah drop 2car = ] unit-test