From bc5807b20afa0af4a3329ce389513785b097421f Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Wed, 30 Sep 2009 02:26:32 -0500
Subject: [PATCH 01/14] add examples to checksums docs
---
core/checksums/checksums-docs.factor | 30 +++++++++++++++++++++++++---
1 file changed, 27 insertions(+), 3 deletions(-)
diff --git a/core/checksums/checksums-docs.factor b/core/checksums/checksums-docs.factor
index a05bf3a685..4ffd6f4427 100644
--- a/core/checksums/checksums-docs.factor
+++ b/core/checksums/checksums-docs.factor
@@ -20,15 +20,39 @@ HELP: checksum-stream
HELP: checksum-bytes
{ $values { "bytes" "a sequence of bytes" } { "checksum" "a checksum specifier" } { "value" byte-array } }
-{ $contract "Computes the checksum of all data in a sequence." } ;
+{ $contract "Computes the checksum of all data in a sequence." }
+{ $examples
+ { $example
+ "USING: checksums checksums.crc32 prettyprint ;"
+ "B{ 1 10 100 } crc32 checksum-bytes ."
+ "B{ 78 179 254 238 }"
+ }
+} ;
HELP: checksum-lines
{ $values { "lines" "a sequence of sequences of bytes" } { "checksum" "a checksum specifier" } { "value" byte-array } }
-{ $contract "Computes the checksum of all data in a sequence." } ;
+{ $contract "Computes the checksum of all data in a sequence." }
+{ $examples
+ { $example
+ "USING: checksums checksums.crc32 prettyprint ;"
+"""{
+ "Take me out to the ball game"
+ "Take me out with the crowd"
+} crc32 checksum-lines ."""
+ "B{ 111 205 9 27 }"
+ }
+} ;
HELP: checksum-file
{ $values { "path" "a pathname specifier" } { "checksum" "a checksum specifier" } { "value" byte-array } }
-{ $contract "Computes the checksum of all data in a file." } ;
+{ $contract "Computes the checksum of all data in a file." }
+{ $examples
+ { $example
+ "USING: checksums checksums.crc32 prettyprint ;"
+ """"resource:license.txt" crc32 checksum-file ."""
+ "B{ 100 139 199 92 }"
+ }
+} ;
ARTICLE: "checksums" "Checksums"
"A " { $emphasis "checksum" } " is a function mapping sequences of bytes to fixed-length strings. While checksums are not one-to-one, a good checksum should have a low probability of collision. Additionally, some checksum algorithms are designed to be hard to reverse, in the sense that finding an input string which hashes to a given checksum string requires a brute-force search."
From 61583862fac2ccb14dd91de109fc9ed35928582e Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Wed, 30 Sep 2009 03:22:11 -0500
Subject: [PATCH 02/14] fix seed-random, random-32* -> random-32
---
basis/random/dummy/dummy.factor | 6 +++---
.../mersenne-twister-tests.factor | 10 ++++++++--
.../mersenne-twister/mersenne-twister.factor | 16 +++++++++++-----
basis/random/random-docs.factor | 12 ++++++++----
basis/random/random.factor | 12 ++++++------
.../blum-blum-shub/blum-blum-shub-tests.factor | 6 +++---
.../random/blum-blum-shub/blum-blum-shub.factor | 2 +-
7 files changed, 40 insertions(+), 24 deletions(-)
diff --git a/basis/random/dummy/dummy.factor b/basis/random/dummy/dummy.factor
index e6661dc078..5763570d75 100644
--- a/basis/random/dummy/dummy.factor
+++ b/basis/random/dummy/dummy.factor
@@ -4,8 +4,8 @@ IN: random.dummy
TUPLE: random-dummy i ;
C: <random-dummy> random-dummy
-M: random-dummy seed-random ( seed obj -- )
- (>>i) ;
+M: random-dummy seed-random ( obj seed -- obj )
+ >>i ;
-M: random-dummy random-32* ( obj -- r )
+M: random-dummy random-32 ( obj -- r )
[ dup 1 + ] change-i drop ;
diff --git a/basis/random/mersenne-twister/mersenne-twister-tests.factor b/basis/random/mersenne-twister/mersenne-twister-tests.factor
index 651e43ef5b..30caa56059 100644
--- a/basis/random/mersenne-twister/mersenne-twister-tests.factor
+++ b/basis/random/mersenne-twister/mersenne-twister-tests.factor
@@ -16,14 +16,20 @@ IN: random.mersenne-twister.tests
[ f ] [ 1234 [ randoms randoms = ] test-rng ] unit-test
[ 1333075495 ] [
- 0 [ 1000 [ drop random-generator get random-32* drop ] each random-generator get random-32* ] test-rng
+ 0 [ 1000 [ drop random-generator get random-32 drop ] each random-generator get random-32 ] test-rng
] unit-test
[ 1575309035 ] [
- 0 [ 10000 [ drop random-generator get random-32* drop ] each random-generator get random-32* ] test-rng
+ 0 [ 10000 [ drop random-generator get random-32 drop ] each random-generator get random-32 ] test-rng
] unit-test
[ 3 ] [ 101 [ 3 random-bytes length ] test-rng ] unit-test
[ 33 ] [ 101 [ 33 random-bytes length ] test-rng ] unit-test
[ t ] [ 101 [ 100 random-bits log2 90 > ] test-rng ] unit-test
+
+[ t ]
+[
+ 1234 <mersenne-twister>
+ [ random-32 ] [ 1234 seed-random random-32 ] bi =
+] unit-test
diff --git a/basis/random/mersenne-twister/mersenne-twister.factor b/basis/random/mersenne-twister/mersenne-twister.factor
index e29f97ef2e..0e65e195e4 100644
--- a/basis/random/mersenne-twister/mersenne-twister.factor
+++ b/basis/random/mersenne-twister/mersenne-twister.factor
@@ -62,15 +62,21 @@ PRIVATE>
init-mt-seq 0 mersenne-twister boa
dup mt-generate ;
-M: mersenne-twister seed-random ( mt seed -- )
- init-mt-seq >>seq drop ;
+M: mersenne-twister seed-random ( mt seed -- mt' )
+ init-mt-seq >>seq
+ [ mt-generate ]
+ [ 0 >>i drop ]
+ [ ] tri ;
-M: mersenne-twister random-32* ( mt -- r )
+M: mersenne-twister random-32 ( mt -- r )
[ next-index ]
[ seq>> nth-unsafe mt-temper ]
[ [ 1 + ] change-i drop ] tri ;
-[
+: default-mersenne-twister ( -- mersenne-twister )
[ 32 random-bits ] with-system-random
- <mersenne-twister> random-generator set-global
+ <mersenne-twister> ;
+
+[
+ default-mersenne-twister random-generator set-global
] "bootstrap.random" add-init-hook
diff --git a/basis/random/random-docs.factor b/basis/random/random-docs.factor
index bb0fc57312..a297df9fd6 100755
--- a/basis/random/random-docs.factor
+++ b/basis/random/random-docs.factor
@@ -2,11 +2,15 @@ USING: help.markup help.syntax math kernel sequences ;
IN: random
HELP: seed-random
-{ $values { "tuple" "a random number generator" } { "seed" "an integer between 0 and 2^32-1" } }
-{ $description "Seed the random number generator." }
+{ $values
+ { "tuple" "a random number generator" }
+ { "seed" "a seed specific to the random number generator" }
+ { "tuple'" "a random number generator" }
+}
+{ $description "Seed the random number generator. Repeatedly seeding the random number generator should provide the same sequence of random numbers." }
{ $notes "Not supported on all random number generators." } ;
-HELP: random-32*
+HELP: random-32
{ $values { "tuple" "a random number generator" } { "r" "an integer between 0 and 2^32-1" } }
{ $description "Generates a random 32-bit unsigned integer." } ;
@@ -92,7 +96,7 @@ HELP: delete-random
ARTICLE: "random-protocol" "Random protocol"
"A random number generator must implement one of these two words:"
-{ $subsection random-32* }
+{ $subsection random-32 }
{ $subsection random-bytes* }
"Optional, to seed a random number generator:"
{ $subsection seed-random } ;
diff --git a/basis/random/random.factor b/basis/random/random.factor
index afdf0b43ba..db15f78ee1 100755
--- a/basis/random/random.factor
+++ b/basis/random/random.factor
@@ -10,19 +10,19 @@ SYMBOL: system-random-generator
SYMBOL: secure-random-generator
SYMBOL: random-generator
-GENERIC: seed-random ( tuple seed -- )
-GENERIC: random-32* ( tuple -- r )
+GENERIC# seed-random 1 ( tuple seed -- tuple' )
+GENERIC: random-32 ( tuple -- r )
GENERIC: random-bytes* ( n tuple -- byte-array )
M: object random-bytes* ( n tuple -- byte-array )
[ [ <byte-vector> ] keep 4 /mod ] dip
- [ pick '[ _ random-32* 4 >le _ push-all ] times ]
+ [ pick '[ _ random-32 4 >le _ push-all ] times ]
[
over zero?
- [ 2drop ] [ random-32* 4 >le swap head over push-all ] if
+ [ 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 random-bytes* le> ;
ERROR: no-random-number-generator ;
@@ -31,7 +31,7 @@ M: no-random-number-generator summary
M: f random-bytes* ( n obj -- * ) no-random-number-generator ;
-M: f random-32* ( obj -- * ) no-random-number-generator ;
+M: f random-32 ( obj -- * ) no-random-number-generator ;
: random-bytes ( n -- byte-array )
random-generator get random-bytes* ;
diff --git a/extra/random/blum-blum-shub/blum-blum-shub-tests.factor b/extra/random/blum-blum-shub/blum-blum-shub-tests.factor
index 4b0dee642e..5b05b09a4c 100644
--- a/extra/random/blum-blum-shub/blum-blum-shub-tests.factor
+++ b/extra/random/blum-blum-shub/blum-blum-shub-tests.factor
@@ -4,7 +4,7 @@ grouping ;
IN: blum-blum-shub.tests
[ 887708070 ] [
- T{ blum-blum-shub f 590695557939 811977232793 } clone random-32*
+ T{ blum-blum-shub f 590695557939 811977232793 } clone random-32
] unit-test
@@ -23,7 +23,7 @@ IN: blum-blum-shub.tests
[ 3716213681 ]
[
100 T{ blum-blum-shub f 200352954495 846054538649 } clone tuck [
- random-32* drop
+ random-32 drop
] curry times
- random-32*
+ random-32
] unit-test
diff --git a/extra/random/blum-blum-shub/blum-blum-shub.factor b/extra/random/blum-blum-shub/blum-blum-shub.factor
index 8229abca69..9f504cefb5 100755
--- a/extra/random/blum-blum-shub/blum-blum-shub.factor
+++ b/extra/random/blum-blum-shub/blum-blum-shub.factor
@@ -25,6 +25,6 @@ PRIVATE>
[ find-relative-prime ] keep
blum-blum-shub boa ;
-M: blum-blum-shub random-32* ( bbs -- r )
+M: blum-blum-shub random-32 ( bbs -- r )
0 32 rot
[ next-bbs-bit swap 1 shift bitor ] curry times ;
From 73d2099faf150f069adb137aa7d60646c85b0f88 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Wed, 30 Sep 2009 03:23:01 -0500
Subject: [PATCH 03/14] add tests file for random.dummy
---
basis/random/dummy/dummy-tests.factor | 7 +++++++
1 file changed, 7 insertions(+)
create mode 100644 basis/random/dummy/dummy-tests.factor
diff --git a/basis/random/dummy/dummy-tests.factor b/basis/random/dummy/dummy-tests.factor
new file mode 100644
index 0000000000..1fa81c4d6e
--- /dev/null
+++ b/basis/random/dummy/dummy-tests.factor
@@ -0,0 +1,7 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: random random.dummy tools.test ;
+IN: random.dummy.tests
+
+[ 10 ] [ 10 <random-dummy> random-32 ] unit-test
+[ 100 ] [ 10 <random-dummy> 100 seed-random random-32 ] unit-test
From cb646db54ae55253ee89216c3f680ea855ddd4ca Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Wed, 30 Sep 2009 11:34:19 -0500
Subject: [PATCH 04/14] add a "test-mr." word to compiler.cfg.debugger
equivalent to "test-mr mr."
---
basis/compiler/cfg/debugger/debugger.factor | 5 ++++-
extra/typed/debugger/debugger.factor | 2 ++
2 files changed, 6 insertions(+), 1 deletion(-)
diff --git a/basis/compiler/cfg/debugger/debugger.factor b/basis/compiler/cfg/debugger/debugger.factor
index 9d91215f3d..d4e8c5401a 100644
--- a/basis/compiler/cfg/debugger/debugger.factor
+++ b/basis/compiler/cfg/debugger/debugger.factor
@@ -44,6 +44,9 @@ M: word test-cfg
nl
] each ;
+: test-mr. ( quot -- )
+ test-mr mr. ; inline
+
! Prettyprinting
: pprint-loc ( loc word -- ) <block pprint-word n>> pprint* block> ;
@@ -79,4 +82,4 @@ M: rs-loc pprint* \ R pprint-loc ;
[ [ defs-vreg ] [ defs-vreg-rep ] bi 2dup and [ 2array ] [ 2drop f ] if ]
bi [ suffix ] when*
] map concat
- ] map concat >hashtable representations set ;
\ No newline at end of file
+ ] map concat >hashtable representations set ;
diff --git a/extra/typed/debugger/debugger.factor b/extra/typed/debugger/debugger.factor
index 452af16a2e..c5f83c0378 100644
--- a/extra/typed/debugger/debugger.factor
+++ b/extra/typed/debugger/debugger.factor
@@ -4,5 +4,7 @@ IN: typed.debugger
: typed-test-mr ( word -- mrs )
"typed-word" word-prop test-mr ; inline
+: typed-test-mr. ( word -- )
+ "typed-word" word-prop test-mr mr. ; inline
: typed-optimized. ( word -- )
"typed-word" word-prop optimized. ; inline
From 3c51312987ac3b26b31a380df726f098143979f0 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Wed, 30 Sep 2009 11:51:44 -0500
Subject: [PATCH 05/14] benchmarks for math.matrices and math.matrices.simd
building and multiplying 3D matrices (vector versions are still slow because
v? and vmask aren't intrinsic yet)
---
.../3d-matrix-scalar/3d-matrix-scalar.factor | 23 +++++++++++++++
.../3d-matrix-vector/3d-matrix-vector.factor | 28 +++++++++++++++++++
2 files changed, 51 insertions(+)
create mode 100644 extra/benchmark/3d-matrix-scalar/3d-matrix-scalar.factor
create mode 100644 extra/benchmark/3d-matrix-vector/3d-matrix-vector.factor
diff --git a/extra/benchmark/3d-matrix-scalar/3d-matrix-scalar.factor b/extra/benchmark/3d-matrix-scalar/3d-matrix-scalar.factor
new file mode 100644
index 0000000000..d629eda6bd
--- /dev/null
+++ b/extra/benchmark/3d-matrix-scalar/3d-matrix-scalar.factor
@@ -0,0 +1,23 @@
+USING: kernel locals math math.matrices math.order math.vectors
+prettyprint sequences ;
+IN: benchmark.3d-matrix-scalar
+
+:: p-matrix ( dim fov near far -- matrix )
+ dim dup first2 min v/n fov v*n near v*n
+ near far frustum-matrix4 ;
+
+:: mv-matrix ( pitch yaw location -- matrix )
+ { 1.0 0.0 0.0 } pitch rotation-matrix4
+ { 0.0 1.0 0.0 } yaw rotation-matrix4
+ location vneg translation-matrix4 m. m. ;
+
+:: 3d-matrix ( -- )
+ f :> result!
+ 100000 [
+ { 1024.0 768.0 } 0.7 0.25 1024.0 p-matrix :> p
+ 3.0 1.0 { 10.0 -0.0 2.0 } mv-matrix :> mv
+ mv p m. result!
+ ] times
+ result . ;
+
+MAIN: 3d-matrix
diff --git a/extra/benchmark/3d-matrix-vector/3d-matrix-vector.factor b/extra/benchmark/3d-matrix-vector/3d-matrix-vector.factor
new file mode 100644
index 0000000000..1b57bb902f
--- /dev/null
+++ b/extra/benchmark/3d-matrix-vector/3d-matrix-vector.factor
@@ -0,0 +1,28 @@
+USING: kernel locals math math.matrices.simd math.order math.vectors
+math.vectors.simd prettyprint sequences typed ;
+QUALIFIED-WITH: alien.c-types c
+SIMD: c:float
+IN: benchmark.3d-matrix-vector
+
+: v2min ( xy -- xx )
+ dup { 1 0 2 3 } vshuffle vmin ; inline
+
+TYPED:: p-matrix ( dim: float-4 fov: float near: float far: float -- matrix: matrix4 )
+ dim dup v2min v/ fov v*n near v*n
+ near far frustum-matrix4 ;
+
+TYPED:: mv-matrix ( pitch: float yaw: float location: float-4 -- matrix: matrix4 )
+ float-4{ 1.0 0.0 0.0 0.0 } pitch rotation-matrix4
+ float-4{ 0.0 1.0 0.0 0.0 } yaw rotation-matrix4
+ location vneg translation-matrix4 m4. m4. ;
+
+:: 3d-matrix ( -- )
+ f :> result!
+ 100000 [
+ float-4{ 1024.0 768.0 0.0 0.0 } 0.7 0.25 1024.0 p-matrix :> p
+ 3.0 1.0 float-4{ 10.0 -0.0 2.0 0.0 } mv-matrix :> mv
+ mv p m4. result!
+ ] times
+ result . ;
+
+MAIN: 3d-matrix
From a2771aa1669604a1537e67b51ad364c8a6e011c7 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Wed, 30 Sep 2009 12:58:32 -0500
Subject: [PATCH 06/14] pit math.matrices and math.matrices.simd against each
other in calculating matrix exponentials
---
.../matrix-exponential-scalar.factor | 24 +++++++++++++++++++
.../matrix-exponential-simd.factor | 18 ++++++++++++++
extra/math/matrices/simd/simd.factor | 15 +++++++++++-
3 files changed, 56 insertions(+), 1 deletion(-)
create mode 100644 extra/benchmark/matrix-exponential-scalar/matrix-exponential-scalar.factor
create mode 100644 extra/benchmark/matrix-exponential-simd/matrix-exponential-simd.factor
diff --git a/extra/benchmark/matrix-exponential-scalar/matrix-exponential-scalar.factor b/extra/benchmark/matrix-exponential-scalar/matrix-exponential-scalar.factor
new file mode 100644
index 0000000000..de4bf1ffe7
--- /dev/null
+++ b/extra/benchmark/matrix-exponential-scalar/matrix-exponential-scalar.factor
@@ -0,0 +1,24 @@
+USING: locals math math.combinatorics math.matrices
+prettyprint sequences typed ;
+IN: benchmark.matrix-exponential-scalar
+
+:: e^m ( m iterations -- e^m )
+ {
+ { 0.0 0.0 0.0 0.0 }
+ { 0.0 0.0 0.0 0.0 }
+ { 0.0 0.0 0.0 0.0 }
+ { 0.0 0.0 0.0 0.0 }
+ }
+ iterations iota [| i |
+ m i m^n i factorial >float m/n m+
+ ] each ;
+
+:: matrix-e ( -- )
+ f :> result!
+ 4 identity-matrix :> i4
+ 10000 [
+ i4 20 e^m result!
+ ] times
+ result . ;
+
+MAIN: matrix-e
diff --git a/extra/benchmark/matrix-exponential-simd/matrix-exponential-simd.factor b/extra/benchmark/matrix-exponential-simd/matrix-exponential-simd.factor
new file mode 100644
index 0000000000..a23b3f2843
--- /dev/null
+++ b/extra/benchmark/matrix-exponential-simd/matrix-exponential-simd.factor
@@ -0,0 +1,18 @@
+USING: locals math math.combinatorics math.matrices.simd
+prettyprint sequences typed ;
+IN: benchmark.matrix-exponential-simd
+
+TYPED:: e^m4 ( m: matrix4 iterations: fixnum -- e^m: matrix4 )
+ zero-matrix4
+ iterations iota [| i |
+ m i m4^n i factorial >float m4/n m4+
+ ] each ;
+
+:: matrix-e ( -- )
+ f :> result!
+ 10000 [
+ identity-matrix4 20 e^m4 result!
+ ] times
+ result . ;
+
+MAIN: matrix-e
diff --git a/extra/math/matrices/simd/simd.factor b/extra/math/matrices/simd/simd.factor
index 014cd86265..0c4c3e1866 100644
--- a/extra/math/matrices/simd/simd.factor
+++ b/extra/math/matrices/simd/simd.factor
@@ -1,6 +1,6 @@
! (c)Joe Groff bsd license
USING: accessors classes.struct generalizations kernel locals
-math math.functions math.matrices.simd math.vectors
+math math.combinatorics math.functions math.matrices.simd math.vectors
math.vectors.simd sequences sequences.private specialized-arrays
typed ;
QUALIFIED-WITH: alien.c-types c
@@ -105,6 +105,19 @@ CONSTANT: identity-matrix4
}
}
+CONSTANT: zero-matrix4
+ S{ matrix4 f
+ float-4-array{
+ float-4{ 0.0 0.0 0.0 0.0 }
+ float-4{ 0.0 0.0 0.0 0.0 }
+ float-4{ 0.0 0.0 0.0 0.0 }
+ float-4{ 0.0 0.0 0.0 0.0 }
+ }
+ }
+
+TYPED:: m4^n ( m: matrix4 n: fixnum -- m^n: matrix4 )
+ identity-matrix4 n [ m m4. ] times ;
+
TYPED:: scale-matrix4 ( factors: float-4 -- matrix: matrix4 )
matrix4 (struct) :> c
From e0f3b72c65c485cd881427ecaa68c9c2498f788c Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Wed, 30 Sep 2009 13:21:25 -0500
Subject: [PATCH 07/14] break math.vectors docs into subsections
---
basis/math/vectors/vectors-docs.factor | 72 ++++++++++++++------------
1 file changed, 40 insertions(+), 32 deletions(-)
diff --git a/basis/math/vectors/vectors-docs.factor b/basis/math/vectors/vectors-docs.factor
index cd539a14e4..1d323822bd 100644
--- a/basis/math/vectors/vectors-docs.factor
+++ b/basis/math/vectors/vectors-docs.factor
@@ -1,10 +1,21 @@
USING: help.markup help.syntax math math.functions sequences ;
IN: math.vectors
-ARTICLE: "math-vectors" "Vector arithmetic"
-"Any Factor sequence can be used to represent a mathematical vector, however for best performance, the sequences defined by the " { $vocab-link "specialized-arrays" } " and " { $vocab-link "math.vectors.simd" } " vocabularies should be used."
-$nl
-"Acting on vectors by a scalar:"
+ARTICLE: "math-vectors-arithmetic" "Vector arithmetic"
+"Vector/vector binary operations:"
+{ $subsection v+ }
+{ $subsection v- }
+{ $subsection v+- }
+{ $subsection v* }
+{ $subsection v/ }
+"Vector unary operations:"
+{ $subsection vneg }
+{ $subsection vabs }
+{ $subsection vsqrt }
+{ $subsection vfloor }
+{ $subsection vceiling }
+{ $subsection vtruncate }
+"Vector/scalar and scalar/vector binary operations:"
{ $subsection vneg }
{ $subsection v*n }
{ $subsection n*v }
@@ -14,24 +25,21 @@ $nl
{ $subsection n+v }
{ $subsection v-n }
{ $subsection n-v }
-"Vector unary operations:"
-{ $subsection vneg }
-{ $subsection vabs }
-{ $subsection vsqrt }
-{ $subsection vfloor }
-{ $subsection vceiling }
-{ $subsection vtruncate }
-"Vector/vector binary operations:"
-{ $subsection v+ }
-{ $subsection v- }
-{ $subsection v+- }
-{ $subsection v* }
-{ $subsection v/ }
"Saturated arithmetic (only on " { $link "specialized-arrays" } "):"
{ $subsection vs+ }
{ $subsection vs- }
{ $subsection vs* }
-"Componentwise vector operations:"
+"Inner product and norm:"
+{ $subsection v. }
+{ $subsection norm }
+{ $subsection norm-sq }
+{ $subsection normalize }
+"Comparing entire vectors:"
+{ $subsection distance }
+{ $subsection v~ } ;
+
+ARTICLE: "math-vectors-logic" "Vector componentwise logic"
+"Element comparisons:"
{ $subsection v< }
{ $subsection v<= }
{ $subsection v= }
@@ -40,6 +48,8 @@ $nl
{ $subsection vunordered? }
{ $subsection vmax }
{ $subsection vmin }
+{ $subsection vsupremum }
+{ $subsection vinfimum }
"Bitwise operations:"
{ $subsection vbitand }
{ $subsection vbitandn }
@@ -47,31 +57,29 @@ $nl
{ $subsection vbitxor }
{ $subsection vlshift }
{ $subsection vrshift }
-"Componentwise logical operations:"
+"Element logical operations:"
{ $subsection vand }
{ $subsection vor }
{ $subsection vxor }
{ $subsection vmask }
{ $subsection v? }
-"Shuffling:"
-{ $subsection vshuffle }
-"Inner product and norm:"
-{ $subsection v. }
-{ $subsection norm }
-{ $subsection norm-sq }
-{ $subsection normalize }
-"Comparing entire vectors:"
-{ $subsection distance }
-{ $subsection v~ }
-"Other functions:"
-{ $subsection vsupremum }
-{ $subsection vinfimum }
+"Element shuffling:"
+{ $subsection vshuffle } ;
+
+ARTICLE: "math-vectors-misc" "Miscellaneous vector functions"
{ $subsection trilerp }
{ $subsection bilerp }
{ $subsection vlerp }
{ $subsection vnlerp }
{ $subsection vbilerp } ;
+
+ARTICLE: "math-vectors" "Vector operations"
+"Any Factor sequence can be used to represent a mathematical vector, however for best performance, the sequences defined by the " { $vocab-link "specialized-arrays" } " and " { $vocab-link "math.vectors.simd" } " vocabularies should be used."
+{ $subsection "math-vectors-arithmetic" }
+{ $subsection "math-vectors-logic" }
+{ $subsection "math-vectors-misc" } ;
+
ABOUT: "math-vectors"
HELP: vneg
From f58e913336f8923786a7067c01ddae2e251db5c1 Mon Sep 17 00:00:00 2001
From: Keith Lazuka <klazuka@gmail.com>
Date: Wed, 30 Sep 2009 14:38:53 -0400
Subject: [PATCH 08/14] help.markup: fix layout bug for "N more results" link
in apropos content
---
basis/help/markup/markup.factor | 10 ++++++----
1 file changed, 6 insertions(+), 4 deletions(-)
diff --git a/basis/help/markup/markup.factor b/basis/help/markup/markup.factor
index 2377a6753a..678d55df61 100644
--- a/basis/help/markup/markup.factor
+++ b/basis/help/markup/markup.factor
@@ -181,20 +181,22 @@ M: word link-long-text
: >topic ( obj -- topic ) dup topic? [ >link ] unless ;
+: topic-span ( topic quot -- ) [ >topic ] dip ($span) ; inline
+
PRIVATE>
-: ($link) ( topic -- ) >topic link-text ;
+: ($link) ( topic -- ) [ link-text ] topic-span ;
: $link ( element -- ) first ($link) ;
-: ($long-link) ( topic -- ) >topic link-long-text ;
+: ($long-link) ( topic -- ) [ link-long-text ] topic-span ;
: $long-link ( element -- ) first ($long-link) ;
: ($pretty-link) ( topic -- )
- >topic [ link-icon ] [ drop bl ] [ link-text ] tri ;
+ [ [ link-icon ] [ drop bl ] [ link-text ] tri ] topic-span ;
: $pretty-link ( element -- ) first ($pretty-link) ;
: ($long-pretty-link) ( topic -- )
- >topic [ link-icon ] [ drop bl ] [ link-long-text ] tri ;
+ [ [ link-icon ] [ drop bl ] [ link-long-text ] tri ] topic-span ;
: <$pretty-link> ( definition -- element )
1array \ $pretty-link prefix ;
From ef237777c3a84ca7a90fc9ea434f9053d0093faa Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Wed, 30 Sep 2009 15:56:02 -0500
Subject: [PATCH 09/14] make random-32* the protocol again, add a random-32
word that doesn't scale the returned bits
---
basis/random/dummy/dummy-tests.factor | 4 ++--
basis/random/dummy/dummy.factor | 2 +-
.../mersenne-twister/mersenne-twister-tests.factor | 6 +++---
.../random/mersenne-twister/mersenne-twister.factor | 2 +-
basis/random/random-docs.factor | 10 ++++++++--
basis/random/random.factor | 12 +++++++-----
.../blum-blum-shub/blum-blum-shub-tests.factor | 6 +++---
extra/random/blum-blum-shub/blum-blum-shub.factor | 2 +-
8 files changed, 26 insertions(+), 18 deletions(-)
diff --git a/basis/random/dummy/dummy-tests.factor b/basis/random/dummy/dummy-tests.factor
index 1fa81c4d6e..5d4b4b5473 100644
--- a/basis/random/dummy/dummy-tests.factor
+++ b/basis/random/dummy/dummy-tests.factor
@@ -3,5 +3,5 @@
USING: random random.dummy tools.test ;
IN: random.dummy.tests
-[ 10 ] [ 10 <random-dummy> random-32 ] unit-test
-[ 100 ] [ 10 <random-dummy> 100 seed-random random-32 ] unit-test
+[ 10 ] [ 10 <random-dummy> random-32* ] unit-test
+[ 100 ] [ 10 <random-dummy> 100 seed-random random-32* ] unit-test
diff --git a/basis/random/dummy/dummy.factor b/basis/random/dummy/dummy.factor
index 5763570d75..988bd015d0 100644
--- a/basis/random/dummy/dummy.factor
+++ b/basis/random/dummy/dummy.factor
@@ -7,5 +7,5 @@ C: <random-dummy> random-dummy
M: random-dummy seed-random ( obj seed -- obj )
>>i ;
-M: random-dummy random-32 ( obj -- r )
+M: random-dummy random-32* ( obj -- r )
[ dup 1 + ] change-i drop ;
diff --git a/basis/random/mersenne-twister/mersenne-twister-tests.factor b/basis/random/mersenne-twister/mersenne-twister-tests.factor
index 30caa56059..b877af6f79 100644
--- a/basis/random/mersenne-twister/mersenne-twister-tests.factor
+++ b/basis/random/mersenne-twister/mersenne-twister-tests.factor
@@ -16,11 +16,11 @@ IN: random.mersenne-twister.tests
[ f ] [ 1234 [ randoms randoms = ] test-rng ] unit-test
[ 1333075495 ] [
- 0 [ 1000 [ drop random-generator get random-32 drop ] each random-generator get random-32 ] test-rng
+ 0 [ 1000 [ drop random-generator get random-32* drop ] each random-generator get random-32* ] test-rng
] unit-test
[ 1575309035 ] [
- 0 [ 10000 [ drop random-generator get random-32 drop ] each random-generator get random-32 ] test-rng
+ 0 [ 10000 [ drop random-generator get random-32* drop ] each random-generator get random-32* ] test-rng
] unit-test
@@ -31,5 +31,5 @@ IN: random.mersenne-twister.tests
[ t ]
[
1234 <mersenne-twister>
- [ random-32 ] [ 1234 seed-random random-32 ] bi =
+ [ random-32* ] [ 1234 seed-random random-32* ] bi =
] unit-test
diff --git a/basis/random/mersenne-twister/mersenne-twister.factor b/basis/random/mersenne-twister/mersenne-twister.factor
index 0e65e195e4..51112ae980 100644
--- a/basis/random/mersenne-twister/mersenne-twister.factor
+++ b/basis/random/mersenne-twister/mersenne-twister.factor
@@ -68,7 +68,7 @@ M: mersenne-twister seed-random ( mt seed -- mt' )
[ 0 >>i drop ]
[ ] tri ;
-M: mersenne-twister random-32 ( mt -- r )
+M: mersenne-twister random-32* ( mt -- r )
[ next-index ]
[ seq>> nth-unsafe mt-temper ]
[ [ 1 + ] change-i drop ] tri ;
diff --git a/basis/random/random-docs.factor b/basis/random/random-docs.factor
index a297df9fd6..79e38ec3b6 100755
--- a/basis/random/random-docs.factor
+++ b/basis/random/random-docs.factor
@@ -10,7 +10,7 @@ HELP: seed-random
{ $description "Seed the random number generator. Repeatedly seeding the random number generator should provide the same sequence of random numbers." }
{ $notes "Not supported on all random number generators." } ;
-HELP: random-32
+HELP: random-32*
{ $values { "tuple" "a random number generator" } { "r" "an integer between 0 and 2^32-1" } }
{ $description "Generates a random 32-bit unsigned integer." } ;
@@ -33,6 +33,10 @@ HELP: random
"heads" }
} ;
+HELP: random-32
+{ $values { "elt" "a 32-bit random integer" } }
+{ $description "Outputs 32 random bits. This word is more efficient than calling " { $link random } " because no scaling is done on the output." } ;
+
HELP: random-bytes
{ $values { "n" "an integer" } { "byte-array" "a random integer" } }
{ $description "Outputs an integer with n bytes worth of bits." }
@@ -96,7 +100,7 @@ HELP: delete-random
ARTICLE: "random-protocol" "Random protocol"
"A random number generator must implement one of these two words:"
-{ $subsection random-32 }
+{ $subsection random-32* }
{ $subsection random-bytes* }
"Optional, to seed a random number generator:"
{ $subsection seed-random } ;
@@ -108,6 +112,8 @@ $nl
$nl
"Generate a random object:"
{ $subsection random }
+"Efficient 32-bit random numbers:"
+{ $subsection random-32 }
"Combinators to change the random number generator:"
{ $subsection with-random }
{ $subsection with-system-random }
diff --git a/basis/random/random.factor b/basis/random/random.factor
index db15f78ee1..1f2408556f 100755
--- a/basis/random/random.factor
+++ b/basis/random/random.factor
@@ -11,18 +11,18 @@ SYMBOL: secure-random-generator
SYMBOL: random-generator
GENERIC# seed-random 1 ( tuple seed -- tuple' )
-GENERIC: random-32 ( tuple -- r )
+GENERIC: random-32* ( tuple -- r )
GENERIC: random-bytes* ( n tuple -- byte-array )
M: object random-bytes* ( n tuple -- byte-array )
[ [ <byte-vector> ] keep 4 /mod ] dip
- [ pick '[ _ random-32 4 >le _ push-all ] times ]
+ [ pick '[ _ random-32* 4 >le _ push-all ] times ]
[
over zero?
- [ 2drop ] [ random-32 4 >le swap head over push-all ] if
+ [ 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 random-bytes* le> ;
ERROR: no-random-number-generator ;
@@ -31,7 +31,7 @@ M: no-random-number-generator summary
M: f random-bytes* ( n obj -- * ) no-random-number-generator ;
-M: f random-32 ( obj -- * ) no-random-number-generator ;
+M: f random-32* ( obj -- * ) no-random-number-generator ;
: random-bytes ( n -- byte-array )
random-generator get random-bytes* ;
@@ -55,6 +55,8 @@ PRIVATE>
[ length random-integer ] keep nth
] if-empty ;
+: random-32 ( -- n ) random-generator get random-32* ;
+
: randomize ( seq -- seq )
dup length [ dup 1 > ]
[ [ iota random ] [ 1 - ] bi [ pick exchange ] keep ]
diff --git a/extra/random/blum-blum-shub/blum-blum-shub-tests.factor b/extra/random/blum-blum-shub/blum-blum-shub-tests.factor
index 5b05b09a4c..4b0dee642e 100644
--- a/extra/random/blum-blum-shub/blum-blum-shub-tests.factor
+++ b/extra/random/blum-blum-shub/blum-blum-shub-tests.factor
@@ -4,7 +4,7 @@ grouping ;
IN: blum-blum-shub.tests
[ 887708070 ] [
- T{ blum-blum-shub f 590695557939 811977232793 } clone random-32
+ T{ blum-blum-shub f 590695557939 811977232793 } clone random-32*
] unit-test
@@ -23,7 +23,7 @@ IN: blum-blum-shub.tests
[ 3716213681 ]
[
100 T{ blum-blum-shub f 200352954495 846054538649 } clone tuck [
- random-32 drop
+ random-32* drop
] curry times
- random-32
+ random-32*
] unit-test
diff --git a/extra/random/blum-blum-shub/blum-blum-shub.factor b/extra/random/blum-blum-shub/blum-blum-shub.factor
index 9f504cefb5..8229abca69 100755
--- a/extra/random/blum-blum-shub/blum-blum-shub.factor
+++ b/extra/random/blum-blum-shub/blum-blum-shub.factor
@@ -25,6 +25,6 @@ PRIVATE>
[ find-relative-prime ] keep
blum-blum-shub boa ;
-M: blum-blum-shub random-32 ( bbs -- r )
+M: blum-blum-shub random-32* ( bbs -- r )
0 32 rot
[ next-bbs-bit swap 1 shift bitor ] curry times ;
From f83698948f191e1d3f660f99aa611738d6573c91 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Wed, 30 Sep 2009 16:17:50 -0500
Subject: [PATCH 10/14] eradicate string C types from windows.com.*
---
basis/windows/com/com-tests.factor | 6 +++---
basis/windows/com/wrapper/wrapper.factor | 18 +++++++++---------
2 files changed, 12 insertions(+), 12 deletions(-)
diff --git a/basis/windows/com/com-tests.factor b/basis/windows/com/com-tests.factor
index 289581a929..ae8ef62c16 100644
--- a/basis/windows/com/com-tests.factor
+++ b/basis/windows/com/com-tests.factor
@@ -37,13 +37,13 @@ TUPLE: test-implementation x ;
C: <test-implementation> test-implementation
{
- { "IInherited" {
+ { IInherited {
[ drop S_OK ] ! ISimple::returnOK
[ drop E_FAIL ] ! ISimple::returnError
[ x>> ] ! IInherited::getX
[ >>x drop ] ! IInherited::setX
} }
- { "IUnrelated" {
+ { IUnrelated {
[ swap x>> + ] ! IUnrelated::xPlus
[ spin x>> * + ] ! IUnrelated::xMulAdd
} }
@@ -85,7 +85,7 @@ dup +test-wrapper+ set [
+guinea-pig-implementation+ get ISimple-iid com-query-interface
dup com-release
] unit-test
- "void*" heap-size +guinea-pig-implementation+ get <displaced-alien>
+ void* heap-size +guinea-pig-implementation+ get <displaced-alien>
+guinea-pig-implementation+ get
2array [
+guinea-pig-implementation+ get IUnrelated-iid com-query-interface
diff --git a/basis/windows/com/wrapper/wrapper.factor b/basis/windows/com/wrapper/wrapper.factor
index e4f0ef0654..27672df833 100755
--- a/basis/windows/com/wrapper/wrapper.factor
+++ b/basis/windows/com/wrapper/wrapper.factor
@@ -52,13 +52,13 @@ unless
swap GUID memory>struct
_ case
[
- "void*" heap-size * rot <displaced-alien> com-add-ref
+ void* heap-size * rot <displaced-alien> com-add-ref
swap 0 set-alien-cell S_OK
] [ nip f swap 0 set-alien-cell E_NOINTERFACE ] if*
] ;
: (make-add-ref) ( interfaces -- quot )
- length "void*" heap-size * '[
+ length void* heap-size * '[
_
[ alien-unsigned-4 1 + dup ]
[ set-alien-unsigned-4 ]
@@ -66,7 +66,7 @@ unless
] ;
: (make-release) ( interfaces -- quot )
- length "void*" heap-size * '[
+ length void* heap-size * '[
_
[ drop ]
[ alien-unsigned-4 1 - dup ]
@@ -84,7 +84,7 @@ unless
: (thunk) ( n -- quot )
dup 0 =
[ drop [ ] ]
- [ "void*" heap-size neg * '[ _ swap <displaced-alien> ] ]
+ [ void* heap-size neg * '[ _ swap <displaced-alien> ] ]
if ;
: (thunked-quots) ( quots iunknown-methods thunk -- {thunk,quot}s )
@@ -97,15 +97,15 @@ unless
[ [ (( -- alien )) define-declared ] pick [ call ] dip ]
with-compilation-unit ;
-: (callback-word) ( function-name interface-name counter -- word )
- [ "::" rot 3append "-callback-" ] dip number>string 3append
+: (callback-word) ( function-name interface counter -- word )
+ [ name>> "::" rot 3append "-callback-" ] dip number>string 3append
"windows.com.wrapper.callbacks" create ;
: (finish-thunk) ( param-count thunk quot -- thunked-quot )
[ [ drop [ ] ] [ swap 1 - '[ _ _ ndip ] ] if-empty ]
dip compose ;
-: (make-interface-callbacks) ( interface-name quots iunknown-methods n -- words )
+: (make-interface-callbacks) ( interface quots iunknown-methods n -- words )
(thunk) (thunked-quots)
swap [ find-com-interface-definition family-tree-functions ]
keep (next-vtbl-counter) '[
@@ -128,8 +128,8 @@ unless
curry map-index ;
: (malloc-wrapped-object) ( wrapper -- wrapped-object )
- vtbls>> length "void*" heap-size *
- [ "ulong" heap-size + malloc ] keep
+ vtbls>> length void* heap-size *
+ [ ulong heap-size + malloc ] keep
[ [ 1 ] 2dip set-alien-unsigned-4 ] [ drop ] 2bi ;
: (callbacks>vtbl) ( callbacks -- vtbl )
From a7dd4ad5cce4e54c44b159e9ae63ac8215945add Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@shill.local>
Date: Wed, 30 Sep 2009 18:22:59 -0500
Subject: [PATCH 11/14] cpu.ppc: update for alien intrinsic changes
---
basis/cpu/ppc/ppc.factor | 24 ++++++++++++------------
1 file changed, 12 insertions(+), 12 deletions(-)
diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor
index 006d38f384..de37cd6ee3 100644
--- a/basis/cpu/ppc/ppc.factor
+++ b/basis/cpu/ppc/ppc.factor
@@ -386,24 +386,24 @@ M:: ppc %box-displaced-alien ( dst displacement base displacement' base' base-cl
"end" resolve-label
] with-scope ;
-M: ppc %alien-unsigned-1 0 LBZ ;
-M: ppc %alien-unsigned-2 0 LHZ ;
+M: ppc %alien-unsigned-1 LBZ ;
+M: ppc %alien-unsigned-2 LHZ ;
-M: ppc %alien-signed-1 dupd 0 LBZ dup EXTSB ;
-M: ppc %alien-signed-2 0 LHA ;
+M: ppc %alien-signed-1 [ dup ] 2dip LBZ dup EXTSB ;
+M: ppc %alien-signed-2 LHA ;
-M: ppc %alien-cell 0 LWZ ;
+M: ppc %alien-cell LWZ ;
-M: ppc %alien-float 0 LFS ;
-M: ppc %alien-double 0 LFD ;
+M: ppc %alien-float LFS ;
+M: ppc %alien-double LFD ;
-M: ppc %set-alien-integer-1 swap 0 STB ;
-M: ppc %set-alien-integer-2 swap 0 STH ;
+M: ppc %set-alien-integer-1 swapd STB ;
+M: ppc %set-alien-integer-2 swapd STH ;
-M: ppc %set-alien-cell swap 0 STW ;
+M: ppc %set-alien-cell swapd STW ;
-M: ppc %set-alien-float swap 0 STFS ;
-M: ppc %set-alien-double swap 0 STFD ;
+M: ppc %set-alien-float swapd STFS ;
+M: ppc %set-alien-double swapd STFD ;
: load-zone-ptr ( reg -- )
"nursery" %load-vm-field-addr ;
From 129b74143722edf3c69942365d216a2ca2a8d478 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Wed, 30 Sep 2009 18:52:01 -0500
Subject: [PATCH 12/14] fix the help lints
---
basis/random/random-docs.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/basis/random/random-docs.factor b/basis/random/random-docs.factor
index 79e38ec3b6..cd645750db 100755
--- a/basis/random/random-docs.factor
+++ b/basis/random/random-docs.factor
@@ -34,7 +34,7 @@ HELP: random
} ;
HELP: random-32
-{ $values { "elt" "a 32-bit random integer" } }
+{ $values { "n" "a 32-bit random integer" } }
{ $description "Outputs 32 random bits. This word is more efficient than calling " { $link random } " because no scaling is done on the output." } ;
HELP: random-bytes
From 2384b630b2ce98fa094e1809e796dacfddaefd51 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@shill.local>
Date: Wed, 30 Sep 2009 20:04:37 -0500
Subject: [PATCH 13/14] math.vectors.simd: use fallbacks for hlshift, hrshift,
vshuffle if parameter is not a literal;al; element access in int-4 on x86-64
now sign-extends the value; don't throw error at compile time if parameter
for vshuffle does not have enough elements
---
.../cfg/instructions/instructions.factor | 4 +--
.../compiler/cfg/intrinsics/simd/simd.factor | 4 ++-
basis/cpu/x86/x86.factor | 34 +++++++++++++------
basis/math/vectors/simd/simd-tests.factor | 21 +++++++++++-
.../specialization/specialization.factor | 11 +++---
5 files changed, 55 insertions(+), 19 deletions(-)
diff --git a/basis/compiler/cfg/instructions/instructions.factor b/basis/compiler/cfg/instructions/instructions.factor
index cf0f668db3..aefa155ec5 100644
--- a/basis/compiler/cfg/instructions/instructions.factor
+++ b/basis/compiler/cfg/instructions/instructions.factor
@@ -404,12 +404,12 @@ literal: rep ;
PURE-INSN: ##shl-vector
def: dst
-use: src1 src2/scalar-rep
+use: src1 src2/int-scalar-rep
literal: rep ;
PURE-INSN: ##shr-vector
def: dst
-use: src1 src2/scalar-rep
+use: src1 src2/int-scalar-rep
literal: rep ;
! Scalar/vector conversion
diff --git a/basis/compiler/cfg/intrinsics/simd/simd.factor b/basis/compiler/cfg/intrinsics/simd/simd.factor
index 51eced4e35..62ee1cf019 100644
--- a/basis/compiler/cfg/intrinsics/simd/simd.factor
+++ b/basis/compiler/cfg/intrinsics/simd/simd.factor
@@ -74,7 +74,9 @@ MACRO: if-literals-match ( quots -- )
: shuffle? ( obj -- ? ) { [ array? ] [ [ integer? ] all? ] } 1&& ;
: emit-shuffle-vector ( node -- )
- [ ^^shuffle-vector ] [unary/param]
+ ! Pad the permutation with zeroes if its too short, since we
+ ! can't throw an error at this point.
+ [ [ rep-components 0 pad-tail ] keep ^^shuffle-vector ] [unary/param]
{ [ shuffle? ] [ representation? ] } if-literals-match ;
: ^^broadcast-vector ( src n rep -- dst )
diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor
index eaaab19662..3c20064313 100644
--- a/basis/cpu/x86/x86.factor
+++ b/basis/cpu/x86/x86.factor
@@ -317,13 +317,19 @@ M:: x86 %set-string-nth-fast ( ch str index temp -- )
: %alien-unsigned-getter ( dst src offset size -- )
[ MOVZX ] %alien-integer-getter ; inline
+: %alien-signed-getter ( dst src offset size -- )
+ [ MOVSX ] %alien-integer-getter ; inline
+
+:: %alien-integer-setter ( ptr offset value size -- )
+ value { ptr } size [| new-value |
+ new-value value int-rep %copy
+ ptr offset [+] new-value size n-bit-version-of MOV
+ ] with-small-register ; inline
+
M: x86 %alien-unsigned-1 8 %alien-unsigned-getter ;
M: x86 %alien-unsigned-2 16 %alien-unsigned-getter ;
M: x86 %alien-unsigned-4 32 [ 2drop ] %alien-integer-getter ;
-: %alien-signed-getter ( dst src offset size -- )
- [ MOVSX ] %alien-integer-getter ; inline
-
M: x86 %alien-signed-1 8 %alien-signed-getter ;
M: x86 %alien-signed-2 16 %alien-signed-getter ;
M: x86 %alien-signed-4 32 %alien-signed-getter ;
@@ -333,12 +339,6 @@ M: x86 %alien-float [+] MOVSS ;
M: x86 %alien-double [+] MOVSD ;
M: x86 %alien-vector [ [+] ] dip %copy ;
-:: %alien-integer-setter ( ptr offset value size -- )
- value { ptr } size [| new-value |
- new-value value int-rep %copy
- ptr offset [+] new-value size n-bit-version-of MOV
- ] with-small-register ; inline
-
M: x86 %set-alien-integer-1 8 %alien-integer-setter ;
M: x86 %set-alien-integer-2 16 %alien-integer-setter ;
M: x86 %set-alien-integer-4 32 %alien-integer-setter ;
@@ -1045,8 +1045,20 @@ M: x86 %shr-vector-reps
: scalar-sized-reg ( reg rep -- reg' )
rep-size 8 * n-bit-version-of ;
-M: x86 %integer>scalar scalar-sized-reg MOVD ;
-M: x86 %scalar>integer swap [ scalar-sized-reg ] dip MOVD ;
+M: x86 %integer>scalar drop MOVD ;
+
+M:: x86 %scalar>integer ( dst src rep -- )
+ rep {
+ { int-scalar-rep [
+ dst 32-bit-version-of src MOVD
+ dst dst 32-bit-version-of
+ 2dup eq? [ 2drop ] [ MOVSX ] if
+ ] }
+ { uint-scalar-rep [
+ dst 32-bit-version-of src MOVD
+ ] }
+ } case ;
+
M: x86 %vector>scalar %copy ;
M: x86 %scalar>vector %copy ;
diff --git a/basis/math/vectors/simd/simd-tests.factor b/basis/math/vectors/simd/simd-tests.factor
index ce17736d75..c676b9fe98 100644
--- a/basis/math/vectors/simd/simd-tests.factor
+++ b/basis/math/vectors/simd/simd-tests.factor
@@ -6,7 +6,7 @@ tools.test vocabs assocs compiler.cfg.debugger words
locals math.vectors.specialization combinators cpu.architecture
math.vectors.simd.intrinsics namespaces byte-arrays alien
specialized-arrays classes.struct eval classes.algebra sets
-quotations math.constants ;
+quotations math.constants compiler.units ;
QUALIFIED-WITH: alien.c-types c
SPECIALIZED-ARRAY: c:float
SIMD: c:char
@@ -216,12 +216,27 @@ simd-classes&reps [
[ int-4{ 256 512 1024 2048 } ]
[ int-4{ 1 2 4 8 } [ { int-4 } declare 1 hlshift ] compile-call ] unit-test
+[ int-4{ 256 512 1024 2048 } ]
+[ int-4{ 1 2 4 8 } 1 [ { int-4 fixnum } declare hlshift ] compile-call ] unit-test
+
[ int-4{ 1 2 4 8 } ]
[ int-4{ 256 512 1024 2048 } 1 hrshift ] unit-test
[ int-4{ 1 2 4 8 } ]
[ int-4{ 256 512 1024 2048 } [ { int-4 } declare 1 hrshift ] compile-call ] unit-test
+[ int-4{ 1 2 4 8 } ]
+[ int-4{ 256 512 1024 2048 } 1 [ { int-4 fixnum } declare hrshift ] compile-call ] unit-test
+
+! Invalid inputs should not cause the compiler to throw errors
+[ ] [
+ [ [ { int-4 } declare t hrshift ] (( a -- b )) define-temp drop ] with-compilation-unit
+] unit-test
+
+[ ] [
+ [ [ { int-4 } declare { 3 2 1 } vshuffle ] (( a -- b )) define-temp drop ] with-compilation-unit
+] unit-test
+
! Shuffles
: shuffles-for ( n -- shuffles )
{
@@ -278,6 +293,7 @@ simd-classes [
[ { } ] [ uint-4{ HEX: ffffffff 2 3 4 } test-accesses ] unit-test
[ HEX: 7fffffff ] [ int-4{ HEX: 7fffffff 3 4 -8 } first ] unit-test
+[ -8 ] [ int-4{ HEX: 7fffffff 3 4 -8 } last ] unit-test
[ HEX: ffffffff ] [ uint-4{ HEX: ffffffff 2 3 4 } first ] unit-test
[ { } ] [ double-2{ 1.0 2.0 } test-accesses ] unit-test
@@ -313,6 +329,9 @@ simd-classes [
[ { } ] [ longlong-4{ 1 2 3 4 } test-broadcast ] unit-test
[ { } ] [ ulonglong-4{ 1 2 3 4 } test-broadcast ] unit-test
+! Make sure we use the fallback in the correct situations
+[ int-4{ 3 3 3 3 } ] [ int-4{ 12 34 3 17 } 2 [ { int-4 fixnum } declare vbroadcast ] compile-call ] unit-test
+
"== Checking alien operations" print
[ float-4{ 1 2 3 4 } ] [
diff --git a/basis/math/vectors/specialization/specialization.factor b/basis/math/vectors/specialization/specialization.factor
index ea9947a0c5..b07615bfc9 100644
--- a/basis/math/vectors/specialization/specialization.factor
+++ b/basis/math/vectors/specialization/specialization.factor
@@ -14,7 +14,7 @@ SYMBOLS: -> +vector+ +scalar+ +nonnegative+ +literal+ ;
{ +vector+ [ drop ] }
{ +scalar+ [ nip ] }
{ +nonnegative+ [ nip ] }
- { +literal+ [ 2drop object ] }
+ { +literal+ [ 2drop f ] }
} case
] with with map ;
@@ -136,7 +136,7 @@ ERROR: bad-vector-word word ;
[ { } ]
} cond
! Don't specialize horizontal shifts or shuffles at all, they're only for SIMD
- { hlshift hrshift vshuffle } diff
+ { hlshift hrshift vshuffle vbroadcast } diff
nip ;
:: specialize-vector-words ( array-type elt-type simd -- )
@@ -147,13 +147,16 @@ ERROR: bad-vector-word word ;
tri add-specialization
] each ;
+: specialization-matches? ( value-infos signature -- ? )
+ [ [ [ class>> ] dip class<= ] [ literal?>> ] if* ] 2all? ;
+
: find-specialization ( classes word -- word/f )
specializations
- [ first [ class<= ] 2all? ] with find
+ [ first specialization-matches? ] with find
swap [ second ] when ;
: vector-word-custom-inlining ( #call -- word/f )
- [ in-d>> [ value-info class>> ] map ] [ word>> ] bi
+ [ in-d>> [ value-info ] map ] [ word>> ] bi
find-specialization ;
vector-words keys [
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 14/14] 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 ) ;