Paste: alt.bitstream
Author: | pruned |
Mode: | factor |
Date: | Sat, 9 May 2009 19:32:19 |
Plain Text |
USING: accessors alien.accessors byte-arrays combinators
constructors fry io io.binary kernel locals macros math
math.parser math.ranges multiline sequences ;
IN: alt.bitstreams
TUPLE: bitstream
{ bytes byte-array }
{ byte-pos fixnum initial: 0 }
{ bit-pos fixnum initial: 0 } ;
TUPLE: msb0-bitstream < bitstream ;
TUPLE: lsb0-bitstream < bitstream ;
CONSTRUCTOR: msb0-bitstream ;
CONSTRUCTOR: lsb0-bitstream ;
GENERIC: peek
GENERIC: poke
: seek
{
[ byte-pos>> 8 * ]
[ bit-pos>> + + 8 /mod ]
[ (>>bit-pos) ]
[ (>>byte-pos) ]
} cleave ; inline
: read
[ peek ] [ seek ] 2bi ; inline
: write
[ poke ] [ seek ] 2bi ; inline
<PRIVATE
MACRO: multi-alien-unsigned-1
[ '[ _ + alien-unsigned-1 ] ] map 2cleave>quot ;
GENERIC: fetch3-le-unsafe
GENERIC: fetch3-be-unsafe
: fetch3-unsafe
multi-alien-unsigned-1 8 2^ * + 8 2^ * + ; inline
M: byte-array fetch3-le-unsafe
swap { 0 1 2 } fetch3-unsafe ; inline
M: byte-array fetch3-be-unsafe
swap { 2 1 0 } fetch3-unsafe ; inline
: fetch3
[ 3 [0,b) [ + ] with map ] dip [ nth ] curry map ;
: fetch3-le fetch3 le> ;
: fetch3-be fetch3 be> ;
GENERIC: peek16
M:: lsb0-bitstream peek16
bs byte-pos>> bs bytes>> fetch3-le
bs bit-pos>> 2^ /i
n 2^ mod ;
M:: msb0-bitstream peek16
bs byte-pos>> bs bytes>> fetch3-be
24 n bs bit-pos>> + - 2^ /i
n 2^ mod ;
PRIVATE>
M: lsb0-bitstream peek peek16 ;
M: msb0-bitstream peek peek16 ;
<PRIVATE
: or-bytes
dup '[ _ byte-pos>> + _ bytes>> [ bitor ] change-nth ] each-index ;
PRIVATE>
: bits>string
swap [ >bin ] [ CHAR: 0 pad-head ] bi* ;
: bits. bits>string print ;
Author: | pruned |
Mode: | factor |
Date: | Sat, 9 May 2009 19:44:05 |
Plain Text |
[ { array-capacity byte-array } declare fetch3-be-unsafe ] test-mr mr.
=== word: , label:
_label 0
##prologue
_label 1
##inc-d -1
##peek V int-regs 1590678 D 0
##peek V int-regs 1590679 D -1
##add-imm V int-regs 1590686 V int-regs 1590678 16
##copy V int-regs 1590689 V int-regs 1590686
##sar-imm V int-regs 1590689 V int-regs 1590689 3
##add-imm V int-regs 1590690 V int-regs 1590679 5
##add V int-regs 1590692 V int-regs 1590689 V int-regs 1590690
##alien-unsigned-1 V int-regs 1590693 V int-regs 1590692
##copy V int-regs 1590694 V int-regs 1590693
##shl-imm V int-regs 1590694 V int-regs 1590694 3
##add-imm V int-regs 1590703 V int-regs 1590678 8
##copy V int-regs 1590706 V int-regs 1590703
##sar-imm V int-regs 1590706 V int-regs 1590706 3
##add V int-regs 1590709 V int-regs 1590706 V int-regs 1590690
##alien-unsigned-1 V int-regs 1590710 V int-regs 1590709
##copy V int-regs 1590711 V int-regs 1590710
##shl-imm V int-regs 1590711 V int-regs 1590711 3
##copy V int-regs 1590716 V int-regs 1590678
##sar-imm V int-regs 1590716 V int-regs 1590716 3
##add V int-regs 1590719 V int-regs 1590716 V int-regs 1590690
##alien-unsigned-1 V int-regs 1590720 V int-regs 1590719
##copy V int-regs 1590721 V int-regs 1590720
##shl-imm V int-regs 1590721 V int-regs 1590721 3
##copy V int-regs 1590724 V int-regs 1590721
##shl-imm V int-regs 1590724 V int-regs 1590724 8
##add V int-regs 1590727 V int-regs 1590711 V int-regs 1590724
##copy V int-regs 1590730 V int-regs 1590727
##shl-imm V int-regs 1590730 V int-regs 1590730 8
##add V int-regs 1590733 V int-regs 1590694 V int-regs 1590730
##replace V int-regs 1590733 D 0
##epilogue
##return
New Annotation