steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Making struct bitfield writers fast

db4
Daniel Ehrenberg 2009-10-08 13:10:51 -05:00
parent 2db25b937e
commit db927ff0ad
3 changed files with 36 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
basis/classes/struct/bit-accessors/bit-accessors-tests.factor Normal file
View File

@ -0,0 +1,7 @@
! Copyright (C) 2009 Daniel Ehrenberg
! See http://factorcode.org/license.txt for BSD license.
USING: classes.struct.bit-accessors tools.test effects kernel random stack-checker ;
IN: classes.struct.bit-accessors.test
[ t ] [ 20 random 20 random bit-reader infer (( alien -- n )) effect= ] unit-test
[ t ] [ 20 random 20 random bit-writer infer (( n alien -- )) effect= ] unit-test

30
basis/classes/struct/bit-accessors/bit-accessors.factor
View File

@ -9,15 +9,15 @@ IN: classes.struct.bit-accessors
: ones-between ( start end -- n ) : ones-between ( start end -- n )
[ 2^ 1 - ] bi@ swap bitnot bitand ; [ 2^ 1 - ] bi@ swap bitnot bitand ;
:: read-bits ( offset bits -- quot: ( byte-array -- n ) shift-amount offset' bits' ) : ones-around ( start end -- n )
ones-between bitnot ;
:: read-bits ( offset bits -- quot: ( alien -- n ) shift-amount offset' bits' )
offset 8 /mod :> start-bit :> i offset 8 /mod :> start-bit :> i
start-bit bits + 8 min :> end-bit start-bit bits + 8 min :> end-bit
start-bit end-bit ones-between :> mask start-bit end-bit ones-between :> mask
end-bit start-bit - :> used-bits end-bit start-bit - :> used-bits
! The code generated for this isn't optimal
! To improve the code, algebraic simplifications should
! have interval information available
[ i alien-unsigned-1 mask bitand start-bit neg shift ] [ i alien-unsigned-1 mask bitand start-bit neg shift ]
used-bits used-bits
i 1 + 8 * i 1 + 8 *
@ -27,3 +27,25 @@ IN: classes.struct.bit-accessors
read-bits dup zero? [ 3drop ] [ read-bits dup zero? [ 3drop ] [
bit-reader swap '[ _ _ bi _ shift bitor ] bit-reader swap '[ _ _ bi _ shift bitor ]
] if ; ] if ;
:: write-bits ( offset bits -- quot: ( alien -- n ) shift-amount offset' bits' )
offset 8 /mod :> start-bit :> i
start-bit bits + 8 min :> end-bit
start-bit end-bit ones-between :> mask
end-bit start-bit - :> used-bits
[
[
[ start-bit shift mask bitand ]
[ i alien-unsigned-1 mask bitnot bitand ]
bi* bitor
] keep i set-alien-unsigned-1
]
used-bits
i 1 + 8 *
bits used-bits - ;
: bit-writer ( offset bits -- quot: ( n alien -- ) )
write-bits dup zero? [ 3drop ] [
bit-writer '[ _ [ [ _ neg shift ] dip @ ] 2bi ]
] if ;

20
basis/classes/struct/struct.factor
View File

@ -116,23 +116,9 @@ M: struct-slot-spec (writer-quot)
[ type>> c-setter ] [ type>> c-setter ]
[ offset>> [ >c-ptr ] swap suffix ] bi prepend ; [ offset>> [ >c-ptr ] swap suffix ] bi prepend ;
QUALIFIED: math.bits M: struct-bit-slot-spec (writer-quot)
[ offset>> ] [ bits>> ] bi bit-writer
: bytes>bits ( byte-array -- bit-array ) [ >c-ptr ] prepose ;
[ 8 math.bits:<bits> ] { } map-as ?{ } join ;
: (write-bits) ( value offset end byte-array -- )
! This is absurdly inefficient
[
[ [ swap - math.bits:<bits> ] 2keep ] [ bytes>bits ] bi*
replace-slice ?{ } like underlying>>
] keep 0 swap copy ;
: bits@ ( slot -- beginning end )
[ offset>> ] [ bits>> ] bi dupd + ;
M: struct-bit-slot-spec (writer-quot) ( slot -- quot )
bits@ '[ [ _ _ ] dip (underlying)>> (write-bits) ] ;
: (boxer-quot) ( class -- quot ) : (boxer-quot) ( class -- quot )
'[ _ memory>struct ] ; '[ _ memory>struct ] ;