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

Refactoring bitfield accessors to eliminate code duplication

db4
Daniel Ehrenberg 2009-10-08 13:45:52 -05:00
parent db927ff0ad
commit 8841969ca1
1 changed files with 28 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -9,43 +9,43 @@ 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 ;
: ones-around ( start end -- n ) :: manipulate-bits ( offset bits step-quot -- quot shift-amount offset' bits' )
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
[ i alien-unsigned-1 mask bitand start-bit neg shift ] start-bit i end-bit mask step-quot call( a b c d -- quot )
used-bits used-bits
i 1 + 8 * i 1 + 8 *
bits used-bits - ; bits used-bits - ; inline
:: bit-manipulator ( offset bits
step-quot: ( start-bit i end-bit mask -- quot )
combine-quot: ( prev-quot shift-amount next-quot -- quot )
-- quot )
offset bits step-quot manipulate-bits
dup zero? [ 3drop ] [
step-quot combine-quot bit-manipulator
combine-quot call( prev shift next -- quot )
] if ; inline recursive
: bit-reader ( offset bits -- quot: ( alien -- n ) ) : bit-reader ( offset bits -- quot: ( alien -- n ) )
read-bits dup zero? [ 3drop ] [ [| start-bit i end-bit mask |
bit-reader swap '[ _ _ bi _ shift bitor ] [ i alien-unsigned-1 mask bitand start-bit neg shift ]
] 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 [ swap '[ _ _ bi _ shift bitor ] ]
i 1 + 8 * bit-manipulator ;
bits used-bits - ;
: bit-writer ( offset bits -- quot: ( n alien -- ) ) : bit-writer ( offset bits -- quot: ( n alien -- ) )
write-bits dup zero? [ 3drop ] [ [| start-bit i end-bit mask |
bit-writer '[ _ [ [ _ neg shift ] dip @ ] 2bi ] [
] if ; [
[ start-bit shift mask bitand ]
[ i alien-unsigned-1 mask bitnot bitand ]
bi* bitor
] keep i set-alien-unsigned-1
]
]
[ '[ _ [ [ _ neg shift ] dip @ ] 2bi ] ]
bit-manipulator ;