"/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 ,
"/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
"Building generic words..." print flush
all-words [ generic? ] subset [ make-generic ] each
+
+FORGET: if-arch
: 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
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
--- /dev/null
+! 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
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