math.vectors.simd.intrinsics: use unrolled loops for some software fallbacks

diff --git a/basis/math/vectors/simd/intrinsics/intrinsics.factor b/basis/math/vectors/simd/intrinsics/intrinsics.factor
index 0ccb6651b992feb01209af9a4cde96292aea14e7..2fe4cc922b8b2aeb5cddd4e483af1b94fb7b7810 100644 (file)
--- a/basis/math/vectors/simd/intrinsics/intrinsics.factor
+++ b/basis/math/vectors/simd/intrinsics/intrinsics.factor
@@ -1,10 +1,10 @@
 ! (c)2009 Slava Pestov, Joe Groff bsd license
-USING: accessors alien alien.c-types alien.data combinators
+USING: accessors alien alien.data combinators
 sequences.cords cpu.architecture fry generalizations grouping
 kernel libc locals macros math math.libm math.order
 math.ranges math.vectors sequences sequences.generalizations
-sequences.private sequences.unrolled specialized-arrays
-vocabs.loader words effects.parser locals.parser ;
+sequences.private sequences.unrolled sequences.unrolled.private
+specialized-arrays vocabs.loader words effects.parser locals.parser ;
 QUALIFIED-WITH: alien.c-types c
 SPECIALIZED-ARRAYS:
     c:char c:short c:int c:longlong
@@ -111,27 +111,31 @@ SYNTAX: SIMD-INTRINSIC::
     [<rep-array>] call( -- a' ) ; inline
 
 : components-map ( a rep quot -- c )
-    [ >rep-array ] dip map underlying>> ; inline
+    [ [ >rep-array ] [ rep-length ] bi ] dip unrolled-map-unsafe underlying>> ; inline
 : components-2map ( a b rep quot -- c )
-    [ 2>rep-array ] dip 2map underlying>> ; inline
+    [ [ 2>rep-array ] [ rep-length ] bi ] dip unrolled-2map-unsafe underlying>> ; inline
+! XXX
 : components-reduce ( a rep quot -- x )
     [ >rep-array [ ] ] dip map-reduce ; inline
 
 : bitwise-components-map ( a rep quot -- c )
-    [ >bitwise-vector-rep >rep-array ] dip map underlying>> ; inline
+    [ >bitwise-vector-rep [ >rep-array ] [ rep-length ] bi ] dip
+    unrolled-map-unsafe underlying>> ; inline
 : bitwise-components-2map ( a b rep quot -- c )
-    [ >bitwise-vector-rep 2>rep-array ] dip 2map underlying>> ; inline
+    [ >bitwise-vector-rep [ 2>rep-array ] [ rep-length ] bi ] dip
+    unrolled-2map-unsafe underlying>> ; inline
+! XXX
 : bitwise-components-reduce ( a rep quot -- x )
     [ >bitwise-vector-rep >rep-array [ ] ] dip map-reduce ; inline
 
 :: (vshuffle) ( a elts rep -- c )
     a rep >rep-array :> a'
     rep <rep-array> :> c'
-    elts [| from to |
+    elts rep rep-length [| from to |
         from rep rep-length 1 - bitand
            a' nth-unsafe
         to c' set-nth-unsafe
-    ] each-index
+    ] unrolled-each-index-unsafe
     c' underlying>> ; inline
 
 :: (vshuffle2) ( a b elts rep -- c )
@@ -139,13 +143,18 @@ SYNTAX: SIMD-INTRINSIC::
     b rep >rep-array :> b'
     a' b' cord-append :> ab'
     rep <rep-array> :> c'
-    elts [| from to |
+    elts rep rep-length [| from to |
         from rep rep-length dup + 1 - bitand
            ab' nth-unsafe
         to c' set-nth-unsafe
-    ] each-index
+    ] unrolled-each-index-unsafe
     c' underlying>> ; inline
 
+GENERIC: native/ ( x y -- x/y )
+
+M: integer native/ /i ; inline
+M: float native/ /f ; inline
+
 PRIVATE>
 
 SIMD-INTRINSIC: (simd-v+)                ( a b rep -- c ) [ + ] components-2map ;
@@ -154,23 +163,23 @@ SIMD-INTRINSIC: (simd-vneg)              ( a   rep -- c ) [ neg ] components-map
 SIMD-INTRINSIC:: (simd-v+-)              ( a b rep -- c ) 
     a b rep 2>rep-array :> ( a' b' )
     rep <rep-array> :> c'
-    0  rep rep-length 1 -  2 <range> [| n |
+    0  rep rep-length [ 1 -  2 <range> ] [ 2 /i ] bi [| n |
         n     a' nth-unsafe n     b' nth-unsafe -
         n     c' set-nth-unsafe
 
         n 1 + a' nth-unsafe n 1 + b' nth-unsafe +
         n 1 + c' set-nth-unsafe
-    ] each
+    ] unrolled-each-unsafe
     c' underlying>> ;
 SIMD-INTRINSIC: (simd-vs+)               ( a b rep -- c )
-    dup rep-component-type '[ + _ c-type-clamp ] components-2map ;
+    dup rep-component-type '[ + _ c:c-type-clamp ] components-2map ;
 SIMD-INTRINSIC: (simd-vs-)               ( a b rep -- c )
-    dup rep-component-type '[ - _ c-type-clamp ] components-2map ;
+    dup rep-component-type '[ - _ c:c-type-clamp ] components-2map ;
 SIMD-INTRINSIC: (simd-vs*)               ( a b rep -- c )
-    dup rep-component-type '[ * _ c-type-clamp ] components-2map ;
+    dup rep-component-type '[ * _ c:c-type-clamp ] components-2map ;
 SIMD-INTRINSIC: (simd-v*)                ( a b rep -- c ) [ * ] components-2map ;
 SIMD-INTRINSIC: (simd-v*high)            ( a b rep -- c )
-    dup rep-component-type heap-size -8 * '[ * _ shift ] components-2map ;
+    dup rep-component-type c:heap-size -8 * '[ * _ shift ] components-2map ;
 SIMD-INTRINSIC:: (simd-v*hs+)            ( a b rep -- c )
     rep { char-16-rep uchar-16-rep } member-eq?
     [ uchar-16-rep char-16-rep ]
@@ -179,16 +188,17 @@ SIMD-INTRINSIC:: (simd-v*hs+)            ( a b rep -- c )
     wide-rep rep-component-type :> wide-type
     a a-rep >rep-array 2 <groups> :> a'
     b b-rep >rep-array 2 <groups> :> b'
-    a' b' [
+    a' b' rep rep-length 2 /i [
         [ [ first  ] bi@ * ]
         [ [ second ] bi@ * ] 2bi +
-        wide-type c-type-clamp
-    ] wide-rep <rep-array> 2map-as underlying>> ;
-SIMD-INTRINSIC: (simd-v/)                ( a b rep -- c ) [ / ] components-2map ;
+        wide-type c:c-type-clamp
+    ] wide-rep <rep-array> unrolled-2map-as-unsafe underlying>> ;
+SIMD-INTRINSIC: (simd-v/)                ( a b rep -- c ) [ native/ ] components-2map ;
 SIMD-INTRINSIC: (simd-vavg)              ( a b rep -- c )
     [ + dup integer? [ 1 + -1 shift ] [ 0.5 * ] if ] components-2map ;
 SIMD-INTRINSIC: (simd-vmin)              ( a b rep -- c ) [ min ] components-2map ;
 SIMD-INTRINSIC: (simd-vmax)              ( a b rep -- c ) [ max ] components-2map ;
+! XXX
 SIMD-INTRINSIC: (simd-v.)                ( a b rep -- n )
     [ 2>rep-array [ [ first ] bi@ * ] 2keep ] keep
     1 swap rep-length [a,b) [ '[ _ swap nth-unsafe ] bi@ * + ] with with each ;
@@ -208,8 +218,10 @@ SIMD-INTRINSIC: (simd-vxor)              ( a b rep -- c ) [ bitxor ] bitwise-com
 SIMD-INTRINSIC: (simd-vnot)              ( a   rep -- c ) [ bitnot ] bitwise-components-map ;
 SIMD-INTRINSIC: (simd-vlshift)           ( a n rep -- c ) swap '[ _ shift ] bitwise-components-map ;
 SIMD-INTRINSIC: (simd-vrshift)           ( a n rep -- c ) swap '[ _ neg shift ] bitwise-components-map ;
+! XXX
 SIMD-INTRINSIC: (simd-hlshift)           ( a n rep -- c )
     drop head-slice* 16 0 pad-head ;
+! XXX
 SIMD-INTRINSIC: (simd-hrshift)           ( a n rep -- c )
     drop tail-slice 16 0 pad-tail ;
 SIMD-INTRINSIC: (simd-vshuffle-elements) ( a n rep -- c ) [ rep-length 0 pad-tail ] keep (vshuffle) ;
@@ -218,19 +230,19 @@ SIMD-INTRINSIC: (simd-vshuffle-bytes)    ( a b rep -- c ) drop uchar-16-rep (vsh
 SIMD-INTRINSIC:: (simd-vmerge-head)      ( a b rep -- c )
     a b rep 2>rep-array :> ( a' b' )
     rep <rep-array> :> c'
-    rep rep-length 2 /i iota [| n |
+    rep rep-length 2 /i [| n |
         n a' nth-unsafe n 2 *     c' set-nth-unsafe
         n b' nth-unsafe n 2 * 1 + c' set-nth-unsafe
-    ] each
+    ] unrolled-each-integer
     c' underlying>> ;
 SIMD-INTRINSIC:: (simd-vmerge-tail)      ( a b rep -- c )
     a b rep 2>rep-array :> ( a' b' )
     rep <rep-array> :> c'
     rep rep-length 2 /i :> len
-    len iota [| n |
+    len [| n |
         n len + a' nth-unsafe n 2 *     c' set-nth-unsafe
         n len + b' nth-unsafe n 2 * 1 + c' set-nth-unsafe
-    ] each
+    ] unrolled-each-integer
     c' underlying>> ;
 SIMD-INTRINSIC: (simd-v<=)               ( a b rep -- c )
     dup rep-tf-values '[ <= _ _ ? ] components-2map ; 
@@ -248,28 +260,33 @@ SIMD-INTRINSIC: (simd-vany?)             ( a   rep -- ? ) [ bitor  ] bitwise-com
 SIMD-INTRINSIC: (simd-vall?)             ( a   rep -- ? ) [ bitand ] bitwise-components-reduce zero? not ;
 SIMD-INTRINSIC: (simd-vnone?)            ( a   rep -- ? ) [ bitor  ] bitwise-components-reduce zero?     ;
 SIMD-INTRINSIC: (simd-v>float)           ( a   rep -- c )
-    [ >rep-array [ >float ] ] [ >float-vector-rep <rep-array> ] bi map-as underlying>> ;
+    [ [ >rep-array ] [ rep-length ] bi [ >float ] ]
+    [ >float-vector-rep <rep-array> ] bi unrolled-map-as-unsafe underlying>> ;
 SIMD-INTRINSIC: (simd-v>integer)         ( a   rep -- c )
-    [ >rep-array [ >integer ] ] [ >int-vector-rep <rep-array> ] bi map-as underlying>> ;
+    [ [ >rep-array ] [ rep-length ] bi [ >integer ] ]
+    [ >int-vector-rep <rep-array> ] bi unrolled-map-as-unsafe underlying>> ;
 SIMD-INTRINSIC: (simd-vpack-signed)      ( a b rep -- c )
-    [ 2>rep-array cord-append ]
+    [ [ 2>rep-array cord-append ] [ rep-length 2 * ] bi ]
     [ narrow-vector-rep [ <rep-array> ] [ rep-component-type ] bi ] bi
-    '[ _ c-type-clamp ] swap map-as underlying>> ;
+    '[ _ c:c-type-clamp ] swap unrolled-map-as-unsafe underlying>> ;
 SIMD-INTRINSIC: (simd-vpack-unsigned)    ( a b rep -- c )
-    [ 2>rep-array cord-append ]
+    [ [ 2>rep-array cord-append ] [ rep-length 2 * ] bi ]
     [ narrow-vector-rep >uint-vector-rep [ <rep-array> ] [ rep-component-type ] bi ] bi
-    '[ _ c-type-clamp ] swap map-as underlying>> ;
+    '[ _ c:c-type-clamp ] swap unrolled-map-as-unsafe underlying>> ;
+! XXX
 SIMD-INTRINSIC: (simd-vunpack-head)      ( a   rep -- c ) 
     [ >rep-array ] [ widen-vector-rep [ rep-length ] [ [>rep-array] ] bi ] bi
     [ head-slice ] dip call( a' -- c' ) underlying>> ;
+! XXX
 SIMD-INTRINSIC: (simd-vunpack-tail)      ( a   rep -- c )
     [ >rep-array ] [ widen-vector-rep [ rep-length ] [ [>rep-array] ] bi ] bi
     [ tail-slice ] dip call( a' -- c' ) underlying>> ;
+! XXX
 SIMD-INTRINSIC: (simd-with)              (   n rep -- v )
     [ rep-length swap '[ _ ] ] [ <rep-array> ] bi replicate-as 
     underlying>> ;
-SIMD-INTRINSIC: (simd-gather-2)          ( m n rep -- v ) <rep-array> [ 2 set-firstn ] keep underlying>> ;
-SIMD-INTRINSIC: (simd-gather-4)          ( m n o p rep -- v ) <rep-array> [ 4 set-firstn ] keep underlying>> ;
+SIMD-INTRINSIC: (simd-gather-2)          ( m n rep -- v ) <rep-array> [ 2 set-firstn-unsafe ] keep underlying>> ;
+SIMD-INTRINSIC: (simd-gather-4)          ( m n o p rep -- v ) <rep-array> [ 4 set-firstn-unsafe ] keep underlying>> ;
 SIMD-INTRINSIC: (simd-select)            ( a n rep -- x ) [ swap ] dip >rep-array nth-unsafe ;
 
 SIMD-INTRINSIC: alien-vector     (       c-ptr n rep -- value )

diff --git a/basis/sequences/unrolled/unrolled.factor b/basis/sequences/unrolled/unrolled.factor
index 1a30e49d5b9d452a57e68643bac99fbbab5d350d..83da65e6db1d9a5cffdb9e78804a67debea4a409 100644 (file)
--- a/basis/sequences/unrolled/unrolled.factor
+++ b/basis/sequences/unrolled/unrolled.factor
@@ -65,6 +65,12 @@ ERROR: unrolled-2bounds-error
 : unrolled-2map-as-unsafe ( xseq yseq len quot: ( x y -- newx ) exemplar -- newseq )
     [ (unrolled-2each) ] dip unrolled-map-integers ; inline
 
+: unrolled-map-unsafe ( seq len quot: ( x -- newx ) -- newseq )
+    pick unrolled-map-as-unsafe ; inline
+
+: unrolled-2map-unsafe ( xseq yseq len quot: ( x y -- newx ) -- newseq )
+    4 npick unrolled-2map-as-unsafe ; inline
+
 PRIVATE>
 
 : unrolled-each ( seq len quot: ( x -- ) -- )