2007-09-20 18:09:08 -04:00
|
|
|
! Copyright (C) 2003, 2007 Slava Pestov.
|
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
|
|
USING: kernel math sequences ;
|
|
|
|
IN: io.binary
|
|
|
|
|
2011-10-12 00:13:30 -04:00
|
|
|
: le> ( seq -- x ) dup length iota 0 [ 8 * shift + ] 2reduce ;
|
|
|
|
: be> ( seq -- x ) 0 [ [ 8 shift ] dip + ] reduce ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2011-11-23 21:49:33 -05:00
|
|
|
: mask-byte ( x -- y ) 0xff bitand ; inline
|
2007-09-20 18:09:08 -04:00
|
|
|
|
|
|
|
: nth-byte ( x n -- b ) -8 * shift mask-byte ; inline
|
|
|
|
|
2009-08-02 19:18:31 -04:00
|
|
|
: >le ( x n -- byte-array ) iota [ nth-byte ] with B{ } map-as ;
|
2009-10-28 15:40:15 -04:00
|
|
|
: >be ( x n -- byte-array ) >le reverse! ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
|
|
|
: d>w/w ( d -- w1 w2 )
|
2011-11-23 21:49:33 -05:00
|
|
|
[ 0xffffffff bitand ]
|
|
|
|
[ -32 shift 0xffffffff bitand ] bi ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
|
|
|
: w>h/h ( w -- h1 h2 )
|
2011-11-23 21:49:33 -05:00
|
|
|
[ 0xffff bitand ]
|
|
|
|
[ -16 shift 0xffff bitand ] bi ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
|
|
|
: h>b/b ( h -- b1 b2 )
|
2009-02-02 00:47:36 -05:00
|
|
|
[ mask-byte ]
|
|
|
|
[ -8 shift mask-byte ] bi ;
|
2009-07-23 16:54:57 -04:00
|
|
|
|
|
|
|
: signed-le> ( bytes -- x )
|
|
|
|
[ le> ] [ length 8 * 1 - 2^ 1 - ] bi
|
|
|
|
2dup > [ bitnot bitor ] [ drop ] if ;
|
|
|
|
|
|
|
|
: signed-be> ( bytes -- x )
|
|
|
|
<reversed> signed-le> ;
|