compiling when/unless

diff --git a/library/compiler/assembly-x86.factor b/library/compiler/assembly-x86.factor
index f757321411dfd41b6a3ee15cab0e145d5cfa99ff..ad5ec4a90dfd2fbd7f7535277da10f5655153fbb 100644 (file)
--- a/library/compiler/assembly-x86.factor
+++ b/library/compiler/assembly-x86.factor
@@ -205,5 +205,8 @@ USE: combinators
 : JE ( -- fixup )
     HEX: 0f compile-byte HEX: 84 compile-byte  (JUMP) ;
 
+: JNE ( -- fixup )
+    HEX: 0f compile-byte HEX: 85 compile-byte  (JUMP) ;
+
 : RET ( -- )
     HEX: c3 compile-byte ;

diff --git a/library/compiler/ifte.factor b/library/compiler/ifte.factor
index 3c919a8d756f1832840e6c7bfab334ed62b63a9c..f91ad58ed2d1286afc89798aec17a1e8951d5620 100644 (file)
--- a/library/compiler/ifte.factor
+++ b/library/compiler/ifte.factor
@@ -33,14 +33,23 @@ USE: kernel
 USE: math
 USE: lists
 
-: compile-f-test ( -- fixup )
-    #! Push addr where we write the branch target address.
+: compile-test ( -- )
     POP-DS
     ! ptr to condition is now in EAX
-    f address EAX CMP-I-[R]
+    f address EAX CMP-I-[R] ;
+
+: compile-f-test ( -- fixup )
+    #! Push addr where we write the branch target address.
+    compile-test
     ! jump w/ address added later
     JE ;
 
+: compile-t-test ( -- fixup )
+    #! Push addr where we write the branch target address.
+    compile-test
+    ! jump w/ address added later
+    JNE ;
+
 : branch-target ( fixup -- )
     compiled-offset swap JUMP-FIXUP ;
 
@@ -61,4 +70,18 @@ USE: lists
     ( f -- ) compile-quot
     r> end-if ;
 
+: compile-when ( compile-time: true -- )
+    pop-literal  commit-literals
+    compile-f-test >r
+    ( t -- ) compile-quot
+    r> end-if ;
+
+: compile-unless ( compile-time: false -- )
+    pop-literal  commit-literals
+    compile-t-test >r
+    ( t -- ) compile-quot
+    r> end-if ;
+
 [ compile-ifte ] \ ifte "compiling" set-word-property
+[ compile-when ] \ when "compiling" set-word-property
+[ compile-unless ] \ unless "compiling" set-word-property

diff --git a/library/inspect-vocabularies.factor b/library/inspect-vocabularies.factor
index 5c50c68cbdd310b30a06bb1a6ceb68146987793a..ec092ea78b769c5c593f454f2def5179fa8eb0b9 100644 (file)
--- a/library/inspect-vocabularies.factor
+++ b/library/inspect-vocabularies.factor
@@ -47,7 +47,7 @@ USE: unparser
 : usages-in-vocab ( of vocab -- usages )
     #! Push a list of all usages of a word in a vocabulary.
     words [
-        dup defined? [
+        dup compound? [
             dupd word-uses?
         ] [
             drop f ! Ignore words without a definition

diff --git a/library/platform/native/boot-stage2.factor b/library/platform/native/boot-stage2.factor
index cb1f2c870d38861531e20167b08058296c9089ab..e11f7f87e8c0ea6acb493a016e2d9174efad4f72 100644 (file)
--- a/library/platform/native/boot-stage2.factor
+++ b/library/platform/native/boot-stage2.factor
@@ -158,8 +158,11 @@ USE: stdio
 IN: init
 DEFER: warm-boot
 
+IN: compiler
+DEFER: init-assembler
+
 : set-boot ( quot -- ) 8 setenv ;
-[ warm-boot ] set-boot
+[ init-assembler warm-boot ] set-boot
 
 garbage-collection
 "factor.image" save-image

diff --git a/library/platform/native/math.factor b/library/platform/native/math.factor
index ddb4a0fa23dafb6bca62da1d943cf057c2ce5797..926d9b7e402543e61f270017ed89650f9798ef76 100644 (file)
--- a/library/platform/native/math.factor
+++ b/library/platform/native/math.factor
@@ -337,23 +337,23 @@ USE: words
 
 : bitnot ( x -- ~x )
     {
-        [ fixnum-bitnot ]
-        [ no-method     ]
-        [ no-method     ]
-        [ no-method     ]
-        [ no-method     ]
-        [ no-method     ]
-        [ no-method     ]
-        [ no-method     ]
-        [ no-method     ]
-        [ no-method     ]
-        [ no-method     ]
-        [ no-method     ]
-        [ no-method     ]
-        [ bignum-bitnot ]
-        [ no-method     ]
-        [ no-method     ]
-        [ no-method     ]
+        fixnum-bitnot
+        no-method
+        no-method
+        no-method
+        no-method
+        no-method
+        no-method
+        no-method
+        no-method
+        no-method
+        no-method
+        no-method
+        no-method
+        bignum-bitnot
+        no-method
+        no-method
+        no-method
     } generic ;
 
 : shift ( x n -- x<<n )

diff --git a/library/platform/native/prettyprint.factor b/library/platform/native/prettyprint.factor
index c241132b3639a8009ec874cba0fb172ba6d40160..61e46e3173e27813150d2d334ad67807ac300904 100644 (file)
--- a/library/platform/native/prettyprint.factor
+++ b/library/platform/native/prettyprint.factor
@@ -66,6 +66,9 @@ USE: words
 : see-primitive ( word -- )
     "PRIMITIVE: " write dup unparse write stack-effect. terpri ;
 
+: see-symbol ( word -- )
+    "SYMBOL: " write . ;
+
 : see-undefined ( word -- )
     drop "Not defined" print ;
 
@@ -74,6 +77,7 @@ USE: words
     intern
     [
         [ compound? ] [ see-compound ]
+        [ symbol? ] [ see-symbol ]
         [ primitive? ] [ see-primitive ]
         [ drop t ] [ see-undefined ]
     ] cond ;

diff --git a/library/platform/native/words.factor b/library/platform/native/words.factor
index 61df6a0652fc90a143eba885cd04685f383d61d1..2f662fed5ecb996945a7b8f9d815c9299a5deeb5 100644 (file)
--- a/library/platform/native/words.factor
+++ b/library/platform/native/words.factor
@@ -30,6 +30,7 @@ USE: combinators
 USE: kernel
 USE: lists
 USE: logic
+USE: math
 USE: namespaces
 USE: stack
 
@@ -46,7 +47,7 @@ USE: stack
     dup word? [ word-primitive 1 = ] [ drop f ] ifte ;
 
 : primitive? ( obj -- ? )
-    dup word? [ word-primitive 1 = not ] [ drop f ] ifte ;
+    dup word? [ word-primitive 2 > ] [ drop f ] ifte ;
 
 : symbol? ( obj -- ? )
     dup word? [ word-primitive 2 = ] [ drop f ] ifte ;

diff --git a/library/test/test.factor b/library/test/test.factor
index 6a2c7f92d10d1b1ebb9017d26696d75fc29a09d9..91fea93009e414f7a0dc1f7718086d70695d094b 100644 (file)
--- a/library/test/test.factor
+++ b/library/test/test.factor
@@ -104,6 +104,9 @@ USE: unparser
     native? [
         [
             "threads"
+            "x86-compiler/simple"
+            "x86-compiler/ifte"
+            "x86-compiler/generic"
         ] [
             test
         ] each

diff --git a/library/test/x86-compiler/ifte.factor b/library/test/x86-compiler/ifte.factor
index a6f14b1bb6bb650b21e7163e54fca4d14fbb9b18..f0f9bca13b230d02c1a65b1834f04acc8f598068 100644 (file)
--- a/library/test/x86-compiler/ifte.factor
+++ b/library/test/x86-compiler/ifte.factor
@@ -61,3 +61,34 @@ DEFER: countdown-b
 : countdown-b ( n -- ) dup 0 eq? [ drop ] [ 1 fixnum- countdown-a ] ifte ; compiled
 
 [ ] [ 10 countdown-b ] unit-test
+
+: dummy-when-1 t [ ] when ; compiled
+
+[ ] [ dummy-when-1 ] unit-test
+
+: dummy-when-2 f [ ] when ; compiled
+
+[ ] [ dummy-when-2 ] unit-test
+
+: dummy-when-3 dup [ dup fixnum* ] when ; compiled
+
+[ 16 ] [ 4 dummy-when-3 ] unit-test
+[ f ] [ f dummy-when-3 ] unit-test
+
+: dummy-when-4 dup [ dup dup fixnum* fixnum* ] when swap ; compiled
+
+[ 64 f ] [ f 4 dummy-when-4 ] unit-test
+[ f t ] [ t f dummy-when-4 ] unit-test
+
+: dummy-unless-1 t [ ] unless ; compiled
+
+[ ] [ dummy-unless-1 ] unit-test
+
+: dummy-unless-2 f [ ] unless ; compiled
+
+[ ] [ dummy-unless-2 ] unit-test
+
+: dummy-unless-3 dup [ drop 3 ] unless ; compiled
+
+[ 3 ] [ f dummy-unless-3 ] unit-test
+[ 4 ] [ 4 dummy-unless-3 ] unit-test