New 'pentium4' architecture

library/bootstrap/boot-stage1.factor

@@ -9,6 +9,10 @@ vectors words ;
 
 "/library/bootstrap/primitives.factor" run-resource
 
+: if-arch ( arch seq -- )
+    architecture rot member?
+    [ [ parse-resource % ] each ] [ drop ] if ;
+
 ! The [ ] make form creates a boot quotation
 [
     \ boot ,
@@ -277,40 +281,34 @@ vectors words ;
         "/doc/handbook/words.facts"
     } [ parse-resource % ] each
     
-    architecture get {
+    { "x86" "pentium4" } {
-        {
+        "/library/compiler/x86/assembler.factor"
-            [ dup "x86" = ] [
+        "/library/compiler/x86/architecture.factor"
-                {
+        "/library/compiler/x86/alien.factor"
-                    "/library/compiler/x86/assembler.factor"
+        "/library/compiler/x86/intrinsics.factor"
-                    "/library/compiler/x86/architecture.factor"
+    } if-arch
-                    "/library/compiler/x86/alien.factor"
+    
-                    "/library/compiler/x86/intrinsics.factor"
+    { "pentium4" } {
-                }
+        "/library/compiler/x86/intrinsics-sse2.factor"
-            ]
+    } if-arch
-        } {
+
-            [ dup "ppc" = ] [
+    { "ppc" } {
-                {
+        "/library/compiler/ppc/assembler.factor"
-                    "/library/compiler/ppc/assembler.factor"
+        "/library/compiler/ppc/architecture.factor"
-                    "/library/compiler/ppc/architecture.factor"
+        "/library/compiler/ppc/intrinsics.factor"
-                    "/library/compiler/ppc/intrinsics.factor"
+    } if-arch
-                }
+
-            ]
+    { "amd64" } {
-        } {
+        "/library/compiler/x86/assembler.factor"
-            [ dup "amd64" = ] [
+        "/library/compiler/amd64/architecture.factor"
-                {
+        "/library/compiler/x86/generator.factor"
-                    "/library/compiler/x86/assembler.factor"
+        "/library/compiler/amd64/generator.factor"
-                    "/library/compiler/amd64/architecture.factor"
+        "/library/compiler/x86/slots.factor"
-                    "/library/compiler/x86/generator.factor"
+        "/library/compiler/amd64/slots.factor"
-                    "/library/compiler/amd64/generator.factor"
+        "/library/compiler/x86/stack.factor"
-                    "/library/compiler/x86/slots.factor"
+        "/library/compiler/x86/fixnum.factor"
-                    "/library/compiler/amd64/slots.factor"
+        "/library/compiler/amd64/alien.factor"
-                    "/library/compiler/x86/stack.factor"
+    } if-arch
-                    "/library/compiler/x86/fixnum.factor"
-                    "/library/compiler/amd64/alien.factor"
-                }
-            ]
-        }
-    } cond [ parse-resource % ] each drop
     
     [
         "/library/bootstrap/boot-stage2.factor" run-resource
@@ -330,3 +328,5 @@ vocabularies get [
 "Building generic words..." print flush
 
 all-words [ generic? ] subset [ make-generic ] each
+
+FORGET: if-arch

library/bootstrap/image.factor

@@ -361,4 +361,4 @@ M: hashtable ' ( hashtable -- pointer )
     ] with-scope ;
 
 : make-images ( -- )
-    { "x86" "ppc" "amd64" } [ make-image ] each ;
+    { "x86" "pentium4" "ppc" "amd64" } [ make-image ] each ;

library/compiler/x86/architecture.factor

@@ -47,6 +47,8 @@ M: float-regs vregs drop { XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7 } ;
 : prepare-division CDQ ; inline
 
 : unboxify-float ( obj vreg quot -- | quot: obj int-vreg )
+    #! The SSE2 code here will never be generated unless SSE2
+    #! intrinsics are loaded.
     over [ float-regs? ] is? [
         swap >r T{ int-regs } alloc-reg [ swap call ] keep
         r> swap [ v>operand ] 2apply float-offset [+] MOVSD
@@ -102,6 +104,8 @@ M: object load-literal ( literal vreg -- )
     swap [ swap vreg-mov ] unboxify-float ;
 
 : %replace ( vreg loc -- )
+    #! The SSE2 code here will never be generated unless SSE2
+    #! intrinsics are loaded.
     over [ float-regs? ] is? [
         ! >r
         ! "fp-scratch" operand "allot.here" f dlsym [] MOV

library/compiler/x86/intrinsics-sse2.factor

@@ -0,0 +1,38 @@
+! Copyright (C) 2005, 2006 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien arrays assembler kernel kernel-internals lists math
+math-internals namespaces sequences words ;
+IN: compiler
+
+! Floats
+: define-float-op ( word op -- )
+    [ [ "x" operand "y" operand ] % , ] [ ] make H{
+        { +input { { float "x" } { float "y" } } }
+        { +output { "x" } }
+    } define-intrinsic ;
+
+{
+    { float+ ADDSD }
+    { float- SUBSD }
+    { float* MULSD }
+    { float/f DIVSD }
+} [
+    first2 define-float-op
+] each
+
+: define-float-jump ( word op -- )
+    [
+        [ end-basic-block "x" operand "y" operand COMISD ] % ,
+    ] [ ] make H{
+        { +input { { float "x" } { float "y" } } }
+    } define-if-intrinsic ;
+
+{
+    { float< JL }
+    { float<= JLE }
+    { float> JG }
+    { float>= JGE }
+    { float= JE }
+} [
+    first2 define-float-jump
+] each

library/compiler/x86/intrinsics.factor

@@ -261,39 +261,6 @@ IN: compiler
     first2 define-fixnum-jump
 ] each
 
-! Floats
-! : define-float-op ( word op -- )
-!     [ [ "x" operand "y" operand ] % , ] [ ] make H{
-!         { +input { { float "x" } { float "y" } } }
-!         { +output { "x" } }
-!     } define-intrinsic ;
-! 
-! {
-!     { float+ ADDSD }
-!     { float- SUBSD }
-!     { float* MULSD }
-!     { float/f DIVSD }
-! } [
-!     first2 define-float-op
-! ] each
-! 
-! : define-float-jump ( word op -- )
-!     [
-!         [ end-basic-block "x" operand "y" operand COMISD ] % ,
-!     ] [ ] make H{
-!         { +input { { float "x" } { float "y" } } }
-!     } define-if-intrinsic ;
-! 
-! {
-!     { float< JL }
-!     { float<= JLE }
-!     { float> JG }
-!     { float>= JGE }
-!     { float= JE }
-! } [
-!     first2 define-float-jump
-! ] each
-
 ! User environment
 : %userenv ( -- )
     "x" operand "userenv" f dlsym MOV