From 0e97398da8baaed526b208002afa946adbb9b469 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Wed, 30 Sep 2009 21:07:57 -0500
Subject: [PATCH 01/10] fix openbsd bootstrap
---
basis/unix/statfs/openbsd/openbsd.factor | 5 +++--
1 file changed, 3 insertions(+), 2 deletions(-)
diff --git a/basis/unix/statfs/openbsd/openbsd.factor b/basis/unix/statfs/openbsd/openbsd.factor
index cd720d74d4..4e65e74c2c 100644
--- a/basis/unix/statfs/openbsd/openbsd.factor
+++ b/basis/unix/statfs/openbsd/openbsd.factor
@@ -1,6 +1,7 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.c-types alien.syntax unix.types unix.stat classes.struct ;
+USING: alien.c-types alien.syntax unix.types classes.struct
+unix.stat ;
IN: unix.statfs.openbsd
CONSTANT: MFSNAMELEN 16
@@ -30,4 +31,4 @@ STRUCT: statfs
{ f_mntfromname { char MNAMELEN } }
{ mount_info char[160] } ;
-FUNCTION: int statfs ( char* path, statvfs* buf ) ;
+FUNCTION: int statfs ( char* path, statfs* buf ) ;
From 0db97d536fe74eaf9751b99f9c1fe8c4d023ed73 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Thu, 1 Oct 2009 07:36:50 -0500
Subject: [PATCH 02/10] math.vectors.simd.functor: don't open-code simd-nth and
simd-with if we cannot generate double precision FP code. Should fix illegal
instruction trap on CPUs with only SSE1
---
basis/math/vectors/simd/functor/functor.factor | 16 ++++++----------
1 file changed, 6 insertions(+), 10 deletions(-)
diff --git a/basis/math/vectors/simd/functor/functor.factor b/basis/math/vectors/simd/functor/functor.factor
index 5b72c544ae..ad45a2c902 100644
--- a/basis/math/vectors/simd/functor/functor.factor
+++ b/basis/math/vectors/simd/functor/functor.factor
@@ -7,6 +7,7 @@ math.vectors.specialization parser prettyprint.custom sequences
sequences.private strings words definitions macros cpu.architecture
namespaces arrays quotations combinators sets layouts ;
QUALIFIED-WITH: alien.c-types c
+QUALIFIED: math.private
IN: math.vectors.simd.functor
ERROR: bad-length got expected ;
@@ -16,8 +17,8 @@ MACRO: simd-boa ( rep class -- simd-array )
: can-be-unboxed? ( type -- ? )
{
- { c:float [ t ] }
- { c:double [ t ] }
+ { c:float [ \ math.private:float+ "intrinsic" word-prop ] }
+ { c:double [ \ math.private:float+ "intrinsic" word-prop ] }
[ c:heap-size cell < ]
} case ;
@@ -37,7 +38,7 @@ MACRO: simd-boa ( rep class -- simd-array )
: simd-with ( rep class x -- simd-array )
[ rep-components ] [ new ] [ '[ _ ] ] tri* swap replicate-as ; inline
-: simd-with-fast? ( rep -- ? )
+: simd-with/nth-fast? ( rep -- ? )
[ \ (simd-vshuffle) supported-simd-op? ]
[ rep-component-type can-be-unboxed? ]
bi and ;
@@ -45,16 +46,11 @@ MACRO: simd-boa ( rep class -- simd-array )
:: define-with-custom-inlining ( word rep class -- )
word [
drop
- rep simd-with-fast? [
+ rep simd-with/nth-fast? [
[ rep rep-coerce rep (simd-with) class boa ]
] [ word def>> ] if
] "custom-inlining" set-word-prop ;
-: simd-nth-fast? ( rep -- ? )
- [ \ (simd-vshuffle) supported-simd-op? ]
- [ rep-component-type can-be-unboxed? ]
- bi and ;
-
: simd-nth-fast ( rep -- quot )
[ rep-components ] keep
'[ swap _ '[ _ _ (simd-select) ] 2array ] map-index
@@ -64,7 +60,7 @@ MACRO: simd-boa ( rep class -- simd-array )
rep-component-type dup c:c-type-getter-boxer c:array-accessor ;
MACRO: simd-nth ( rep -- x )
- dup simd-nth-fast? [ simd-nth-fast ] [ simd-nth-slow ] if ;
+ dup simd-with/nth-fast? [ simd-nth-fast ] [ simd-nth-slow ] if ;
: boa-effect ( rep n -- effect )
[ rep-components ] dip *
From 69829a534d36095d3d59a44fe5a65690611075aa Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Thu, 1 Oct 2009 07:44:14 -0500
Subject: [PATCH 03/10] cpu.ppc: fix again
---
basis/cpu/ppc/ppc.factor | 10 +++++-----
1 file changed, 5 insertions(+), 5 deletions(-)
diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor
index de37cd6ee3..11dbc27ac0 100644
--- a/basis/cpu/ppc/ppc.factor
+++ b/basis/cpu/ppc/ppc.factor
@@ -397,13 +397,13 @@ M: ppc %alien-cell LWZ ;
M: ppc %alien-float LFS ;
M: ppc %alien-double LFD ;
-M: ppc %set-alien-integer-1 swapd STB ;
-M: ppc %set-alien-integer-2 swapd STH ;
+M: ppc %set-alien-integer-1 -rot STB ;
+M: ppc %set-alien-integer-2 -rot STH ;
-M: ppc %set-alien-cell swapd STW ;
+M: ppc %set-alien-cell -rot STW ;
-M: ppc %set-alien-float swapd STFS ;
-M: ppc %set-alien-double swapd STFD ;
+M: ppc %set-alien-float -rot STFS ;
+M: ppc %set-alien-double -rot STFD ;
: load-zone-ptr ( reg -- )
"nursery" %load-vm-field-addr ;
From ccc69a5ef4883d2eac34a953cb561d19dfab73fe Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Thu, 1 Oct 2009 11:58:52 -0500
Subject: [PATCH 04/10] fix bug in random-bytes* when no random-32* exists
---
basis/random/random-tests.factor | 3 +++
basis/random/random.factor | 2 +-
2 files changed, 4 insertions(+), 1 deletion(-)
diff --git a/basis/random/random-tests.factor b/basis/random/random-tests.factor
index da8d4a1844..96dc8cc783 100644
--- a/basis/random/random-tests.factor
+++ b/basis/random/random-tests.factor
@@ -30,3 +30,6 @@ IN: random.tests
[ 3 ] [ { 1 2 3 4 } 3 sample prune length ] unit-test
[ 99 ] [ 100 99 sample prune length ] unit-test
+
+[ ]
+[ [ 100 random-bytes ] with-system-random drop ] unit-test
diff --git a/basis/random/random.factor b/basis/random/random.factor
index 1f2408556f..197c232404 100755
--- a/basis/random/random.factor
+++ b/basis/random/random.factor
@@ -22,7 +22,7 @@ M: object random-bytes* ( n tuple -- byte-array )
[ 2drop ] [ random-32* 4 >le swap head over push-all ] if
] bi-curry bi* ;
-M: object random-32* ( tuple -- r ) 4 random-bytes* le> ;
+M: object random-32* ( tuple -- r ) 4 swap random-bytes* le> ;
ERROR: no-random-number-generator ;
From 5c972d96794c49c20c37fc516c2f8677c855ba5d Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Thu, 1 Oct 2009 13:48:28 -0500
Subject: [PATCH 05/10] check that the length of checksum-lines is correct for
md
---
basis/checksums/md5/md5-tests.factor | 6 ++++++
1 file changed, 6 insertions(+)
diff --git a/basis/checksums/md5/md5-tests.factor b/basis/checksums/md5/md5-tests.factor
index 730c0b8516..92f7ef4089 100644
--- a/basis/checksums/md5/md5-tests.factor
+++ b/basis/checksums/md5/md5-tests.factor
@@ -33,3 +33,9 @@ IN: checksums.md5.tests
<md5-state> "asdf" binary <byte-reader> add-checksum-stream
[ get-checksum ] [ get-checksum ] bi =
] unit-test
+
+[
+ t
+] [
+ { "abcd" "efg" } md5 checksum-lines length 16 =
+] unit-test
From 34c4bd6d8f9b7f19f461fb382bbfd42322a4e439 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Thu, 1 Oct 2009 17:07:57 -0500
Subject: [PATCH 06/10] add a using
---
basis/checksums/md5/md5-tests.factor | 3 ++-
1 file changed, 2 insertions(+), 1 deletion(-)
diff --git a/basis/checksums/md5/md5-tests.factor b/basis/checksums/md5/md5-tests.factor
index 92f7ef4089..45dc253c86 100644
--- a/basis/checksums/md5/md5-tests.factor
+++ b/basis/checksums/md5/md5-tests.factor
@@ -1,7 +1,8 @@
! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: byte-arrays checksums checksums.md5 io.encodings.binary
-io.streams.byte-array kernel math namespaces tools.test ;
+io.streams.byte-array kernel math namespaces tools.test
+sequences ;
IN: checksums.md5.tests
[ "d41d8cd98f00b204e9800998ecf8427e" ] [ "" >byte-array md5 checksum-bytes hex-string ] unit-test
From b9577e2b0ea677d18a6914cdcbb101439ef0ece6 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@shill.local>
Date: Thu, 1 Oct 2009 18:07:50 -0500
Subject: [PATCH 07/10] compiler.cfg.instructions: remove ##box-float,
##unbox-float, ##box-vector, ##unbox-vector since they can be expressed in
terms of ##alien-double, ##set-alien-double, ##alien-vector,
##set-alien-vector, and ##allot
---
.../cfg/gc-checks/gc-checks-tests.factor | 2 +-
basis/compiler/cfg/hats/hats.factor | 15 -----------
.../cfg/instructions/instructions.factor | 23 ----------------
.../cfg/intrinsics/alien/alien.factor | 8 ++++--
.../cfg/intrinsics/allot/allot.factor | 9 +++++++
.../cfg/intrinsics/slots/slots.factor | 3 +++
.../representations/representations.factor | 27 ++++++++++++-------
.../value-numbering-tests.factor | 10 +++----
basis/compiler/codegen/codegen.factor | 4 ---
basis/compiler/tests/low-level-ir.factor | 14 ----------
basis/cpu/architecture/architecture.factor | 6 -----
basis/cpu/ppc/ppc.factor | 6 -----
basis/cpu/x86/x86.factor | 17 ------------
13 files changed, 40 insertions(+), 104 deletions(-)
diff --git a/basis/compiler/cfg/gc-checks/gc-checks-tests.factor b/basis/compiler/cfg/gc-checks/gc-checks-tests.factor
index 5580de9a47..27d37b115f 100644
--- a/basis/compiler/cfg/gc-checks/gc-checks-tests.factor
+++ b/basis/compiler/cfg/gc-checks/gc-checks-tests.factor
@@ -16,7 +16,7 @@ V{
} 0 test-bb
V{
- T{ ##box-float f 0 1 }
+ T{ ##box-alien f 0 1 }
} 1 test-bb
0 1 edge
diff --git a/basis/compiler/cfg/hats/hats.factor b/basis/compiler/cfg/hats/hats.factor
index cf5c0095ca..42aa5512bc 100644
--- a/basis/compiler/cfg/hats/hats.factor
+++ b/basis/compiler/cfg/hats/hats.factor
@@ -49,24 +49,9 @@ insn-classes get [
[ ##load-reference ]
} cond ;
-: ^^unbox-c-ptr ( src class -- dst )
- [ next-vreg dup ] 2dip next-vreg ##unbox-c-ptr ;
-
-: ^^allot-tuple ( n -- dst )
- 2 + cells tuple ^^allot ;
-
-: ^^allot-array ( n -- dst )
- 2 + cells array ^^allot ;
-
-: ^^allot-byte-array ( n -- dst )
- 2 cells + byte-array ^^allot ;
-
: ^^offset>slot ( slot -- vreg' )
cell 4 = [ 1 ^^shr-imm ] [ any-rep ^^copy ] if ;
-: ^^tag-offset>slot ( slot tag -- vreg' )
- [ ^^offset>slot ] dip ^^sub-imm ;
-
: ^^tag-fixnum ( src -- dst )
tag-bits get ^^shl-imm ;
diff --git a/basis/compiler/cfg/instructions/instructions.factor b/basis/compiler/cfg/instructions/instructions.factor
index aefa155ec5..e69516dded 100644
--- a/basis/compiler/cfg/instructions/instructions.factor
+++ b/basis/compiler/cfg/instructions/instructions.factor
@@ -199,15 +199,6 @@ def: dst/int-rep
use: src/int-rep ;
! Float arithmetic
-PURE-INSN: ##unbox-float
-def: dst/double-rep
-use: src/int-rep ;
-
-PURE-INSN: ##box-float
-def: dst/int-rep
-use: src/double-rep
-temp: temp/int-rep ;
-
PURE-INSN: ##add-float
def: dst/double-rep
use: src1/double-rep src2/double-rep ;
@@ -266,18 +257,6 @@ def: dst/double-rep
use: src/int-rep ;
! SIMD operations
-
-PURE-INSN: ##box-vector
-def: dst/int-rep
-use: src
-literal: rep
-temp: temp/int-rep ;
-
-PURE-INSN: ##unbox-vector
-def: dst
-use: src/int-rep
-literal: rep ;
-
PURE-INSN: ##zero-vector
def: dst
literal: rep ;
@@ -738,8 +717,6 @@ literal: n ;
UNION: ##allocation
##allot
-##box-float
-##box-vector
##box-alien
##box-displaced-alien ;
diff --git a/basis/compiler/cfg/intrinsics/alien/alien.factor b/basis/compiler/cfg/intrinsics/alien/alien.factor
index bc6baa21b7..a37e100c3e 100644
--- a/basis/compiler/cfg/intrinsics/alien/alien.factor
+++ b/basis/compiler/cfg/intrinsics/alien/alien.factor
@@ -3,8 +3,9 @@
USING: accessors kernel sequences alien math classes.algebra fry
locals combinators combinators.short-circuit cpu.architecture
compiler.tree.propagation.info compiler.cfg.hats
-compiler.cfg.stacks compiler.cfg.instructions
-compiler.cfg.utilities compiler.cfg.builder.blocks ;
+compiler.cfg.registers compiler.cfg.stacks
+compiler.cfg.instructions compiler.cfg.utilities
+compiler.cfg.builder.blocks ;
IN: compiler.cfg.intrinsics.alien
: emit-<displaced-alien>? ( node -- ? )
@@ -33,6 +34,9 @@ IN: compiler.cfg.intrinsics.alien
[ second class>> fixnum class<= ]
bi and ;
+: ^^unbox-c-ptr ( src class -- dst )
+ [ next-vreg dup ] 2dip next-vreg ##unbox-c-ptr ;
+
: prepare-alien-accessor ( info -- ptr-vreg offset )
class>> [ 2inputs ^^untag-fixnum swap ] dip ^^unbox-c-ptr ^^add 0 ;
diff --git a/basis/compiler/cfg/intrinsics/allot/allot.factor b/basis/compiler/cfg/intrinsics/allot/allot.factor
index d4aa2750c0..6ad5450bfc 100644
--- a/basis/compiler/cfg/intrinsics/allot/allot.factor
+++ b/basis/compiler/cfg/intrinsics/allot/allot.factor
@@ -18,6 +18,9 @@ IN: compiler.cfg.intrinsics.allot
: tuple-slot-regs ( layout -- vregs )
[ second ds-load ] [ ^^load-literal ] bi prefix ;
+: ^^allot-tuple ( n -- dst )
+ 2 + cells tuple ^^allot ;
+
: emit-<tuple-boa> ( node -- )
dup node-input-infos last literal>>
dup array? [
@@ -36,6 +39,9 @@ IN: compiler.cfg.intrinsics.allot
: expand-<array>? ( obj -- ? )
dup integer? [ 0 8 between? ] [ drop f ] if ;
+: ^^allot-array ( n -- dst )
+ 2 + cells array ^^allot ;
+
:: emit-<array> ( node -- )
[let | len [ node node-input-infos first literal>> ] |
len expand-<array>? [
@@ -54,6 +60,9 @@ IN: compiler.cfg.intrinsics.allot
: bytes>cells ( m -- n ) cell align cell /i ;
+: ^^allot-byte-array ( n -- dst )
+ 2 cells + byte-array ^^allot ;
+
: emit-allot-byte-array ( len -- dst )
ds-drop
dup ^^allot-byte-array
diff --git a/basis/compiler/cfg/intrinsics/slots/slots.factor b/basis/compiler/cfg/intrinsics/slots/slots.factor
index 07202ae60b..8ee1c41cfb 100644
--- a/basis/compiler/cfg/intrinsics/slots/slots.factor
+++ b/basis/compiler/cfg/intrinsics/slots/slots.factor
@@ -8,6 +8,9 @@ IN: compiler.cfg.intrinsics.slots
: value-tag ( info -- n ) class>> class-tag ; inline
+: ^^tag-offset>slot ( slot tag -- vreg' )
+ [ ^^offset>slot ] dip ^^sub-imm ;
+
: (emit-slot) ( infos -- dst )
[ 2inputs ] [ first value-tag ] bi*
^^tag-offset>slot ^^slot ;
diff --git a/basis/compiler/cfg/representations/representations.factor b/basis/compiler/cfg/representations/representations.factor
index 423f415742..f31184cecf 100644
--- a/basis/compiler/cfg/representations/representations.factor
+++ b/basis/compiler/cfg/representations/representations.factor
@@ -1,8 +1,10 @@
! Copyright (C) 2009 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
USING: kernel fry accessors sequences assocs sets namespaces
-arrays combinators combinators.short-circuit make locals deques
-dlists layouts cpu.architecture compiler.utilities
+arrays combinators combinators.short-circuit math make locals
+deques dlists layouts byte-arrays cpu.architecture
+compiler.utilities
+compiler.constants
compiler.cfg
compiler.cfg.rpo
compiler.cfg.hats
@@ -25,24 +27,31 @@ GENERIC: emit-unbox ( dst src rep -- )
M:: float-rep emit-box ( dst src rep -- )
double-rep next-vreg-rep :> temp
temp src ##single>double-float
- dst temp int-rep next-vreg-rep ##box-float ;
+ dst temp double-rep emit-box ;
M:: float-rep emit-unbox ( dst src rep -- )
double-rep next-vreg-rep :> temp
- temp src ##unbox-float
+ temp src double-rep emit-unbox
dst temp ##double>single-float ;
M: double-rep emit-box
- drop int-rep next-vreg-rep ##box-float ;
+ drop
+ [ drop 16 float int-rep next-vreg-rep ##allot ]
+ [ float-offset swap ##set-alien-double ]
+ 2bi ;
M: double-rep emit-unbox
- drop ##unbox-float ;
+ drop float-offset ##alien-double ;
-M: vector-rep emit-box
- int-rep next-vreg-rep ##box-vector ;
+M:: vector-rep emit-box ( dst src rep -- )
+ int-rep next-vreg-rep :> temp
+ dst 16 2 cells + byte-array int-rep next-vreg-rep ##allot
+ temp 16 tag-fixnum ##load-immediate
+ temp dst 1 byte-array tag-number ##set-slot-imm
+ dst byte-array-offset src rep ##set-alien-vector ;
M: vector-rep emit-unbox
- ##unbox-vector ;
+ byte-array-offset ##alien-vector ;
M:: scalar-rep emit-box ( dst src rep -- )
int-rep next-vreg-rep :> temp
diff --git a/basis/compiler/cfg/value-numbering/value-numbering-tests.factor b/basis/compiler/cfg/value-numbering/value-numbering-tests.factor
index b2750da3fa..f81a672108 100644
--- a/basis/compiler/cfg/value-numbering/value-numbering-tests.factor
+++ b/basis/compiler/cfg/value-numbering/value-numbering-tests.factor
@@ -107,19 +107,15 @@ IN: compiler.cfg.value-numbering.tests
{
T{ ##peek f 8 D 0 }
T{ ##peek f 9 D -1 }
- T{ ##unbox-float f 10 8 }
- T{ ##unbox-float f 11 9 }
- T{ ##compare-float-unordered f 12 10 11 cc< }
- T{ ##compare-float-unordered f 14 10 11 cc/< }
+ T{ ##compare-float-unordered f 12 8 9 cc< }
+ T{ ##compare-float-unordered f 14 8 9 cc/< }
T{ ##replace f 14 D 0 }
}
] [
{
T{ ##peek f 8 D 0 }
T{ ##peek f 9 D -1 }
- T{ ##unbox-float f 10 8 }
- T{ ##unbox-float f 11 9 }
- T{ ##compare-float-unordered f 12 10 11 cc< }
+ T{ ##compare-float-unordered f 12 8 9 cc< }
T{ ##compare-imm f 14 12 5 cc= }
T{ ##replace f 14 D 0 }
} value-numbering-step trim-temps
diff --git a/basis/compiler/codegen/codegen.factor b/basis/compiler/codegen/codegen.factor
index b0307f685d..7689862347 100755
--- a/basis/compiler/codegen/codegen.factor
+++ b/basis/compiler/codegen/codegen.factor
@@ -146,8 +146,6 @@ CODEGEN: ##not %not
CODEGEN: ##neg %neg
CODEGEN: ##log2 %log2
CODEGEN: ##copy %copy
-CODEGEN: ##unbox-float %unbox-float
-CODEGEN: ##box-float %box-float
CODEGEN: ##add-float %add-float
CODEGEN: ##sub-float %sub-float
CODEGEN: ##mul-float %mul-float
@@ -161,12 +159,10 @@ CODEGEN: ##single>double-float %single>double-float
CODEGEN: ##double>single-float %double>single-float
CODEGEN: ##integer>float %integer>float
CODEGEN: ##float>integer %float>integer
-CODEGEN: ##unbox-vector %unbox-vector
CODEGEN: ##zero-vector %zero-vector
CODEGEN: ##gather-vector-2 %gather-vector-2
CODEGEN: ##gather-vector-4 %gather-vector-4
CODEGEN: ##shuffle-vector %shuffle-vector
-CODEGEN: ##box-vector %box-vector
CODEGEN: ##add-vector %add-vector
CODEGEN: ##saturated-add-vector %saturated-add-vector
CODEGEN: ##add-sub-vector %add-sub-vector
diff --git a/basis/compiler/tests/low-level-ir.factor b/basis/compiler/tests/low-level-ir.factor
index 0b2da64636..e508b55b8d 100644
--- a/basis/compiler/tests/low-level-ir.factor
+++ b/basis/compiler/tests/low-level-ir.factor
@@ -46,20 +46,6 @@ IN: compiler.tests.low-level-ir
} compile-test-bb
] unit-test
-! ##copy on floats. We can only run this test if float intrinsics
-! are enabled.
-\ float+ "intrinsic" word-prop [
- [ 1.5 ] [
- V{
- T{ ##load-reference f 4 1.5 }
- T{ ##unbox-float f 1 4 }
- T{ ##copy f 2 1 double-rep }
- T{ ##box-float f 3 2 }
- T{ ##copy f 0 3 int-rep }
- } compile-test-bb
- ] unit-test
-] when
-
! make sure slot access works when the destination is
! one of the sources
[ t ] [
diff --git a/basis/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor
index 3b1f57d08e..dc1c2eeb0c 100644
--- a/basis/cpu/architecture/architecture.factor
+++ b/basis/cpu/architecture/architecture.factor
@@ -197,9 +197,6 @@ HOOK: %fixnum-add cpu ( label dst src1 src2 -- )
HOOK: %fixnum-sub cpu ( label dst src1 src2 -- )
HOOK: %fixnum-mul cpu ( label dst src1 src2 -- )
-HOOK: %unbox-float cpu ( dst src -- )
-HOOK: %box-float cpu ( dst src temp -- )
-
HOOK: %add-float cpu ( dst src1 src2 -- )
HOOK: %sub-float cpu ( dst src1 src2 -- )
HOOK: %mul-float cpu ( dst src1 src2 -- )
@@ -216,9 +213,6 @@ HOOK: %double>single-float cpu ( dst src -- )
HOOK: %integer>float cpu ( dst src -- )
HOOK: %float>integer cpu ( dst src -- )
-HOOK: %box-vector cpu ( dst src temp rep -- )
-HOOK: %unbox-vector cpu ( dst src rep -- )
-
HOOK: %zero-vector cpu ( dst rep -- )
HOOK: %gather-vector-2 cpu ( dst src1 src2 rep -- )
HOOK: %gather-vector-4 cpu ( dst src1 src2 src3 src4 rep -- )
diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor
index 11dbc27ac0..67a65b8ecd 100644
--- a/basis/cpu/ppc/ppc.factor
+++ b/basis/cpu/ppc/ppc.factor
@@ -230,12 +230,6 @@ M: ppc %copy ( dst src rep -- )
} case
] if ;
-M: ppc %unbox-float ( dst src -- ) float-offset LFD ;
-
-M:: ppc %box-float ( dst src temp -- )
- dst 16 float temp %allot
- src dst float-offset STFD ;
-
GENERIC: float-function-param* ( dst src -- )
M: spill-slot float-function-param* [ 1 ] dip n>> spill@ LFD ;
diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor
index 3c20064313..71d76a1ce5 100644
--- a/basis/cpu/x86/x86.factor
+++ b/basis/cpu/x86/x86.factor
@@ -474,13 +474,6 @@ M: x86 %double>single-float CVTSD2SS ;
M: x86 %integer>float CVTSI2SD ;
M: x86 %float>integer CVTTSD2SI ;
-M: x86 %unbox-float ( dst src -- )
- float-offset [+] MOVSD ;
-
-M:: x86 %box-float ( dst src temp -- )
- dst 16 float temp %allot
- dst float-offset [+] src MOVSD ;
-
: %cmov-float= ( dst src -- )
[
"no-move" define-label
@@ -561,16 +554,6 @@ M: x86 %compare-float-ordered-branch ( label src1 src2 cc -- )
M: x86 %compare-float-unordered-branch ( label src1 src2 cc -- )
\ UCOMISD (%compare-float-branch) ;
-M:: x86 %box-vector ( dst src rep temp -- )
- dst rep rep-size 2 cells + byte-array temp %allot
- 16 tag-fixnum dst 1 byte-array tag-number %set-slot-imm
- dst byte-array-offset [+]
- src rep %copy ;
-
-M:: x86 %unbox-vector ( dst src rep -- )
- dst src byte-array-offset [+]
- rep %copy ;
-
MACRO: available-reps ( alist -- )
! Each SSE version adds new representations and supports
! all old ones
From c3d81cefe9742698f23ac0e9d4a514dac9579445 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@shill.local>
Date: Thu, 1 Oct 2009 19:41:23 -0500
Subject: [PATCH 08/10] compiler.cfg: don't unbox the same value more than once
per basic block
---
basis/compiler/cfg/builder/builder-tests.factor | 13 +++++++++----
.../cfg/representations/representations.factor | 14 ++++++++++++--
2 files changed, 21 insertions(+), 6 deletions(-)
diff --git a/basis/compiler/cfg/builder/builder-tests.factor b/basis/compiler/cfg/builder/builder-tests.factor
index 9a77ee4017..d303cc597f 100644
--- a/basis/compiler/cfg/builder/builder-tests.factor
+++ b/basis/compiler/cfg/builder/builder-tests.factor
@@ -159,9 +159,12 @@ IN: compiler.cfg.builder.tests
{ pinned-c-ptr class fixnum } \ set-alien-cell '[ _ declare _ execute ] unit-test-cfg
] each
-: contains-insn? ( quot insn-check -- ? )
+: count-insns ( quot insn-check -- ? )
[ test-mr [ instructions>> ] map ] dip
- '[ _ any? ] any? ; inline
+ '[ _ count ] sigma ; inline
+
+: contains-insn? ( quot insn-check -- ? )
+ count-insns 0 > ; inline
[ t ] [ [ swap ] [ ##replace? ] contains-insn? ] unit-test
@@ -197,14 +200,16 @@ IN: compiler.cfg.builder.tests
[ f t ] [
[ { byte-array fixnum } declare alien-cell 4 alien-float ]
[ [ ##box-alien? ] contains-insn? ]
- [ [ ##box-float? ] contains-insn? ] bi
+ [ [ ##allot? ] contains-insn? ] bi
] unit-test
[ f t ] [
[ { byte-array fixnum } declare alien-cell { simple-alien } declare 4 alien-float ]
[ [ ##box-alien? ] contains-insn? ]
- [ [ ##box-float? ] contains-insn? ] bi
+ [ [ ##allot? ] contains-insn? ] bi
] unit-test
+
+ [ 1 ] [ [ dup float+ ] [ ##alien-double? ] count-insns ] unit-test
] when
! Regression. Make sure everything is inlined correctly
diff --git a/basis/compiler/cfg/representations/representations.factor b/basis/compiler/cfg/representations/representations.factor
index f31184cecf..a2311ca964 100644
--- a/basis/compiler/cfg/representations/representations.factor
+++ b/basis/compiler/cfg/representations/representations.factor
@@ -51,7 +51,7 @@ M:: vector-rep emit-box ( dst src rep -- )
dst byte-array-offset src rep ##set-alien-vector ;
M: vector-rep emit-unbox
- byte-array-offset ##alien-vector ;
+ [ byte-array-offset ] dip ##alien-vector ;
M:: scalar-rep emit-box ( dst src rep -- )
int-rep next-vreg-rep :> temp
@@ -152,6 +152,9 @@ SYMBOL: costs
! Insert conversions. This introduces new temporaries, so we need
! to rename opearands too.
+! Mapping from vreg,rep pairs to vregs
+SYMBOL: alternatives
+
:: emit-def-conversion ( dst preferred required -- new-dst' )
! If an instruction defines a register with representation 'required',
! but the register has preferred representation 'preferred', then
@@ -164,7 +167,13 @@ SYMBOL: costs
! but the register has preferred representation 'preferred', then
! we rename the instruction's input to a new register, which
! becomes the output of a conversion instruction.
- required next-vreg-rep [ src required preferred emit-conversion ] keep ;
+ preferred required eq? [ src ] [
+ src required alternatives get [
+ required next-vreg-rep :> new-src
+ [ new-src ] 2dip preferred emit-conversion
+ new-src
+ ] 2cache
+ ] if ;
SYMBOLS: renaming-set needs-renaming? ;
@@ -245,6 +254,7 @@ M: insn conversions-for-insn , ;
dup kill-block? [ drop ] [
[
[
+ H{ } clone alternatives set
[ conversions-for-insn ] each
] V{ } make
] change-instructions drop
From 59e234b251a2873ff7f268570ca686ef98bb431b Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Thu, 1 Oct 2009 23:12:53 -0500
Subject: [PATCH 09/10] specialized-arrays: byte-array>A-array calls >c-ptr
---
basis/specialized-arrays/specialized-arrays.factor | 12 ++++++++----
1 file changed, 8 insertions(+), 4 deletions(-)
diff --git a/basis/specialized-arrays/specialized-arrays.factor b/basis/specialized-arrays/specialized-arrays.factor
index 9692980858..b8a3332600 100755
--- a/basis/specialized-arrays/specialized-arrays.factor
+++ b/basis/specialized-arrays/specialized-arrays.factor
@@ -54,14 +54,18 @@ TUPLE: A
: <direct-A> ( alien len -- specialized-array ) A boa ; inline
-: <A> ( n -- specialized-array ) [ \ T <underlying> ] keep <direct-A> ; inline
+: <A> ( n -- specialized-array )
+ [ \ T <underlying> ] keep <direct-A> ; inline
-: (A) ( n -- specialized-array ) [ \ T (underlying) ] keep <direct-A> ; inline
+: (A) ( n -- specialized-array )
+ [ \ T (underlying) ] keep <direct-A> ; inline
-: malloc-A ( len -- specialized-array ) [ \ T heap-size calloc ] keep <direct-A> ; inline
+: malloc-A ( len -- specialized-array )
+ [ \ T heap-size calloc ] keep <direct-A> ; inline
: byte-array>A ( byte-array -- specialized-array )
- dup length \ T heap-size /mod 0 = [ drop \ T bad-byte-array-length ] unless
+ >c-ptr dup length \ T heap-size /mod 0 =
+ [ drop \ T bad-byte-array-length ] unless
<direct-A> ; inline
M: A clone [ underlying>> clone ] [ length>> ] bi <direct-A> ; inline
From 56a4b323efa45a8b5ab07a27249363119e8b2506 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Thu, 1 Oct 2009 23:13:33 -0500
Subject: [PATCH 10/10] sequences: add accumulate-as and document insert-nth
---
core/sequences/sequences-docs.factor | 17 ++++++++++++++---
core/sequences/sequences.factor | 5 ++++-
2 files changed, 18 insertions(+), 4 deletions(-)
diff --git a/core/sequences/sequences-docs.factor b/core/sequences/sequences-docs.factor
index 64cbb5955a..561096d9f7 100755
--- a/core/sequences/sequences-docs.factor
+++ b/core/sequences/sequences-docs.factor
@@ -276,9 +276,19 @@ HELP: reduce-index
"153"
} } ;
+HELP: accumulate-as
+{ $values { "identity" object } { "seq" sequence } { "quot" { $quotation "( prev elt -- next )" } } { "exemplar" sequence } { "final" "the final result" } { "newseq" "a new sequence" } }
+{ $description "Combines successive elements of the sequence using a binary operation, and outputs a sequence of the same type as " { $snippet "exemplar" } " containing intermediate results, together with the final result."
+$nl
+"The first element of the new sequence is " { $snippet "identity" } ". Then, on the first iteration, the two inputs to the quotation are " { $snippet "identity" } ", and the first element of the old sequence. On successive iterations, the first input is the result of the previous iteration, and the second input is the corresponding element of the old sequence."
+$nl
+"When given the empty sequence, outputs an empty sequence together with the " { $snippet "identity" } "." } ;
+
HELP: accumulate
-{ $values { "identity" object } { "seq" sequence } { "quot" { $quotation "( prev elt -- next )" } } { "final" "the final result" } { "newseq" "a new sequence" } }
-{ $description "Combines successive elements of the sequence using a binary operation, and outputs a sequence of intermediate results together with the final result. The first element of the new sequence is " { $snippet "identity" } ". Then, on the first iteration, the two inputs to the quotation are " { $snippet "identity" } ", and the first element of the old sequence. On successive iterations, the first input is the result of the previous iteration, and the second input is the corresponding element of the old sequence."
+{ $values { "identity" object } { "seq" sequence } { "quot" { $quotation "( prev elt -- next )" } } { "final" "the final result" } { "newseq" "a new array" } }
+{ $description "Combines successive elements of the sequence using a binary operation, and outputs an array of intermediate results, together with the final result."
+$nl
+"The first element of the new sequence is " { $snippet "identity" } ". Then, on the first iteration, the two inputs to the quotation are " { $snippet "identity" } ", and the first element of the old sequence. On successive iterations, the first input is the result of the previous iteration, and the second input is the corresponding element of the old sequence."
$nl
"When given the empty sequence, outputs an empty sequence together with the " { $snippet "identity" } "." }
{ $examples
@@ -1400,7 +1410,7 @@ ARTICLE: "sequences-access" "Accessing sequence elements"
ARTICLE: "sequences-add-remove" "Adding and removing sequence elements"
"Adding elements:"
-{ $subsections prefix suffix }
+{ $subsections prefix suffix insert-nth }
"Removing elements:"
{ $subsections remove remq remove-nth } ;
@@ -1495,6 +1505,7 @@ ARTICLE: "sequences-combinators" "Sequence combinators"
map-index
map-reduce
accumulate
+ accumulate-as
produce
produce-as
}
diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor
index de49a339c9..c64095cb73 100755
--- a/core/sequences/sequences.factor
+++ b/core/sequences/sequences.factor
@@ -432,8 +432,11 @@ PRIVATE>
: change-each ( seq quot -- )
over map-into ; inline
+: accumulate-as ( seq identity quot exemplar -- final newseq )
+ [ [ swap ] dip [ curry keep ] curry ] dip map-as ; inline
+
: accumulate ( seq identity quot -- final newseq )
- swapd [ [ call ] [ 2drop ] 3bi ] curry { } map-as ; inline
+ { } accumulate-as ; inline
: 2each ( seq1 seq2 quot -- )
(2each) each-integer ; inline