From 2fa14f55ad3a37b357066082bf3ea286d5229f95 Mon Sep 17 00:00:00 2001
From: slava <slava@factorcode.org>
Date: Fri, 5 May 2006 06:08:37 +0000
Subject: [PATCH] New 'pentium4' architecture

---
 library/bootstrap/boot-stage1.factor        | 68 ++++++++++-----------
 library/bootstrap/image.factor              |  2 +-
 library/compiler/x86/architecture.factor    |  4 ++
 library/compiler/x86/intrinsics-sse2.factor | 38 ++++++++++++
 library/compiler/x86/intrinsics.factor      | 33 ----------
 5 files changed, 77 insertions(+), 68 deletions(-)
 create mode 100644 library/compiler/x86/intrinsics-sse2.factor

diff --git a/library/bootstrap/boot-stage1.factor b/library/bootstrap/boot-stage1.factor
index 72ebb79b79..bb217acdf6 100644
--- a/library/bootstrap/boot-stage1.factor
+++ b/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 {
-        {
-            [ dup "x86" = ] [
-                {
-                    "/library/compiler/x86/assembler.factor"
-                    "/library/compiler/x86/architecture.factor"
-                    "/library/compiler/x86/alien.factor"
-                    "/library/compiler/x86/intrinsics.factor"
-                }
-            ]
-        } {
-            [ dup "ppc" = ] [
-                {
-                    "/library/compiler/ppc/assembler.factor"
-                    "/library/compiler/ppc/architecture.factor"
-                    "/library/compiler/ppc/intrinsics.factor"
-                }
-            ]
-        } {
-            [ dup "amd64" = ] [
-                {
-                    "/library/compiler/x86/assembler.factor"
-                    "/library/compiler/amd64/architecture.factor"
-                    "/library/compiler/x86/generator.factor"
-                    "/library/compiler/amd64/generator.factor"
-                    "/library/compiler/x86/slots.factor"
-                    "/library/compiler/amd64/slots.factor"
-                    "/library/compiler/x86/stack.factor"
-                    "/library/compiler/x86/fixnum.factor"
-                    "/library/compiler/amd64/alien.factor"
-                }
-            ]
-        }
-    } cond [ parse-resource % ] each drop
+    { "x86" "pentium4" } {
+        "/library/compiler/x86/assembler.factor"
+        "/library/compiler/x86/architecture.factor"
+        "/library/compiler/x86/alien.factor"
+        "/library/compiler/x86/intrinsics.factor"
+    } if-arch
+    
+    { "pentium4" } {
+        "/library/compiler/x86/intrinsics-sse2.factor"
+    } if-arch
+
+    { "ppc" } {
+        "/library/compiler/ppc/assembler.factor"
+        "/library/compiler/ppc/architecture.factor"
+        "/library/compiler/ppc/intrinsics.factor"
+    } if-arch
+
+    { "amd64" } {
+        "/library/compiler/x86/assembler.factor"
+        "/library/compiler/amd64/architecture.factor"
+        "/library/compiler/x86/generator.factor"
+        "/library/compiler/amd64/generator.factor"
+        "/library/compiler/x86/slots.factor"
+        "/library/compiler/amd64/slots.factor"
+        "/library/compiler/x86/stack.factor"
+        "/library/compiler/x86/fixnum.factor"
+        "/library/compiler/amd64/alien.factor"
+    } if-arch
     
     [
         "/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
diff --git a/library/bootstrap/image.factor b/library/bootstrap/image.factor
index dabb7de804..a0ee4204cf 100644
--- a/library/bootstrap/image.factor
+++ b/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 ;
diff --git a/library/compiler/x86/architecture.factor b/library/compiler/x86/architecture.factor
index 70a0a20614..676a6a2801 100644
--- a/library/compiler/x86/architecture.factor
+++ b/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
diff --git a/library/compiler/x86/intrinsics-sse2.factor b/library/compiler/x86/intrinsics-sse2.factor
new file mode 100644
index 0000000000..239d63e456
--- /dev/null
+++ b/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
diff --git a/library/compiler/x86/intrinsics.factor b/library/compiler/x86/intrinsics.factor
index e98ab9ec33..c4aea1c22d 100644
--- a/library/compiler/x86/intrinsics.factor
+++ b/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