diff --git a/basis/generalizations/generalizations-docs.factor b/basis/generalizations/generalizations-docs.factor index 4a4d4be318..f5c0de2ea2 100644 --- a/basis/generalizations/generalizations-docs.factor +++ b/basis/generalizations/generalizations-docs.factor @@ -172,7 +172,7 @@ HELP: ndip } ; HELP: nkeep -{ $values { "quot" quotation } { "n" integer } } +{ $values { "n" integer } } { $description "A generalization of " { $link keep } " that can work " "for any stack depth. The first " { $snippet "n" } " items after the quotation will be " "saved, the quotation called, and the items restored." diff --git a/extra/alien/data/map/map-tests.factor b/extra/alien/data/map/map-tests.factor index f8c7cb0914..e6845d1847 100644 --- a/extra/alien/data/map/map-tests.factor +++ b/extra/alien/data/map/map-tests.factor @@ -1,5 +1,5 @@ ! (c)Joe Groff bsd license -USING: alien.data.map fry generalizations kernel math.vectors +USING: alien.data.map fry generalizations kernel locals math.vectors math.vectors.conversion math math.vectors.simd specialized-arrays tools.test ; FROM: alien.c-types => uchar short int float ; @@ -19,6 +19,13 @@ IN: alien.data.map.tests [ dup ] data-map!( int -- float[2] ) ] unit-test +:: float-pixels>byte-pixels-locals ( floats scale bias -- bytes ) + floats [ + [ scale 255.0 * v*n bias 255.0 * v+n float-4 int-4 vconvert ] 4 napply + [ int-4 short-8 vconvert ] 2bi@ + short-8 uchar-16 vconvert + ] data-map( float-4[4] -- uchar-16 ) ; inline + : float-pixels>byte-pixels* ( floats scale bias -- bytes ) '[ [ _ 255.0 * v*n _ 255.0 * v+n float-4 int-4 vconvert ] 4 napply @@ -29,6 +36,22 @@ IN: alien.data.map.tests : float-pixels>byte-pixels ( floats -- bytes ) 1.0 0.0 float-pixels>byte-pixels* ; +[ + B{ + 127 191 255 63 + 255 25 51 76 + 76 51 229 127 + 25 255 255 255 + } +] [ + float-array{ + 0.5 0.75 1.0 0.25 + 1.0 0.1 0.2 0.3 + 0.3 0.2 0.9 0.5 + 0.1 1.0 1.5 2.0 + } 1.0 0.0 float-pixels>byte-pixels-locals +] unit-test + [ B{ 127 191 255 63 diff --git a/extra/alien/data/map/map.factor b/extra/alien/data/map/map.factor index ea232fb15a..d4c24ef18f 100644 --- a/extra/alien/data/map/map.factor +++ b/extra/alien/data/map/map.factor @@ -1,7 +1,7 @@ ! (c)Joe Groff bsd license USING: accessors alien alien.c-types alien.data alien.parser arrays byte-arrays combinators effects.parser fry generalizations kernel -lexer locals macros math math.ranges parser sequences sequences.private ; +lexer locals macros make math math.ranges parser sequences sequences.private ; IN: alien.data.map ERROR: bad-data-map-input-length byte-length iter-size remainder ; @@ -39,27 +39,23 @@ INSTANCE: data-map-param immutable-sequence dup array? [ unclip swap product >fixnum ] [ 1 ] if 2dup swap heap-size * >fixnum ; inline -MACRO:: >param ( in -- quot: ( array -- param ) ) - in c-type-count :> iter-length :> count :> c-type - - [ - [ c-type count ] dip +MACRO: >param ( in -- quot: ( array -- param ) ) + c-type-count '[ + [ _ _ ] dip [ ] [ >c-ptr ] [ byte-length ] tri - iter-length + _ 2dup /i data-map-param boa ] ; -MACRO:: alloc-param ( out -- quot: ( len -- param ) ) - out c-type-count :> iter-length :> count :> c-type - - [ - [ c-type count ] dip +MACRO: alloc-param ( out -- quot: ( len -- param ) ) + c-type-count dup '[ + [ _ _ ] dip [ - iter-length * >fixnum [ (byte-array) dup ] keep - iter-length + _ * >fixnum [ (byte-array) dup ] keep + _ ] keep data-map-param boa ] ; @@ -76,14 +72,17 @@ MACRO: pack-params ( outs -- ) outs length :> #outs #ins #outs + :> #params - [| quot | - param-quot call + [ + param-quot % [ - [ [ ins unpack-params quot call ] #outs ndip outs pack-params ] - #params neach - ] #outs nkeep - [ orig>> ] #outs napply - ] ; + [ + [ ins , \ unpack-params , \ @ , ] [ ] make , + #outs , \ ndip , outs , \ pack-params , + ] [ ] make , + #params , \ neach , + ] [ ] make , #outs , \ nkeep , + [ orig>> ] , #outs , \ napply , + ] [ ] make fry \ call suffix ; MACRO: data-map ( ins outs -- ) 2dup