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

Cleaning up classes.struct.bit-accessors code

db4
Daniel Ehrenberg 2009-10-08 14:01:43 -05:00
parent 8841969ca1
commit 891b7c9804
1 changed files with 9 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -15,13 +15,13 @@ IN: classes.struct.bit-accessors
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
start-bit i end-bit mask step-quot call( a b c d -- quot ) i mask start-bit step-quot call( i mask start-bit -- quot )
used-bits used-bits
i 1 + 8 * i 1 + 8 *
bits used-bits - ; inline bits used-bits - ; inline
:: bit-manipulator ( offset bits :: bit-manipulator ( offset bits
step-quot: ( start-bit i end-bit mask -- quot ) step-quot: ( i mask start-bit -- quot )
combine-quot: ( prev-quot shift-amount next-quot -- quot ) combine-quot: ( prev-quot shift-amount next-quot -- quot )
-- quot ) -- quot )
offset bits step-quot manipulate-bits offset bits step-quot manipulate-bits
@ -31,21 +31,16 @@ IN: classes.struct.bit-accessors
] if ; inline recursive ] if ; inline recursive
: bit-reader ( offset bits -- quot: ( alien -- n ) ) : bit-reader ( offset bits -- quot: ( alien -- n ) )
[| start-bit i end-bit mask | [ neg '[ _ alien-unsigned-1 _ bitand _ shift ] ]
[ i alien-unsigned-1 mask bitand start-bit neg shift ]
]
[ swap '[ _ _ bi _ shift bitor ] ] [ swap '[ _ _ bi _ shift bitor ] ]
bit-manipulator ; bit-manipulator ;
:: write-bits ( n alien i mask start-bit -- )
n start-bit shift mask bitand
alien i alien-unsigned-1 mask bitnot bitand
bitor alien i set-alien-unsigned-1 ; inline
: bit-writer ( offset bits -- quot: ( n alien -- ) ) : bit-writer ( offset bits -- quot: ( n alien -- ) )
[| start-bit i end-bit mask | [ '[ _ _ _ write-bits ] ]
[
[
[ start-bit shift mask bitand ]
[ i alien-unsigned-1 mask bitnot bitand ]
bi* bitor
] keep i set-alien-unsigned-1
]
]
[ '[ _ [ [ _ neg shift ] dip @ ] 2bi ] ] [ '[ _ [ [ _ neg shift ] dip @ ] 2bi ] ]
bit-manipulator ; bit-manipulator ;