1 ! Copyright (C) 2009 Daniel Ehrenberg
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: kernel sequences math fry locals math.order alien.accessors ;
4 IN: classes.struct.bit-accessors
6 ! Bitfield accessors are little-endian on all platforms
7 ! Why not? It's unspecified in C
9 : ones-between ( start end -- n )
10 [ 2^ 1 - ] bi@ swap bitnot bitand ;
12 :: manipulate-bits ( offset bits step-quot -- quot shift-amount offset' bits' )
13 offset 8 /mod :> start-bit :> i
14 start-bit bits + 8 min :> end-bit
15 start-bit end-bit ones-between :> mask
16 end-bit start-bit - :> used-bits
18 i mask start-bit step-quot call( i mask start-bit -- quot )
21 bits used-bits - ; inline
23 :: bit-manipulator ( offset bits
24 step-quot: ( i mask start-bit -- quot )
25 combine-quot: ( prev-quot shift-amount next-quot -- quot )
27 offset bits step-quot manipulate-bits
29 step-quot combine-quot bit-manipulator
30 combine-quot call( prev shift next -- quot )
31 ] if ; inline recursive
33 : bit-reader ( offset bits -- quot: ( alien -- n ) )
34 [ neg '[ _ alien-unsigned-1 _ bitand _ shift ] ]
35 [ swap '[ _ _ bi _ shift bitor ] ]
38 :: write-bits ( n alien i mask start-bit -- )
39 n start-bit shift mask bitand
40 alien i alien-unsigned-1 mask bitnot bitand
41 bitor alien i set-alien-unsigned-1 ; inline
43 : bit-writer ( offset bits -- quot: ( n alien -- ) )
44 [ '[ _ _ _ write-bits ] ]
45 [ '[ _ [ [ _ neg shift ] dip @ ] 2bi ] ]