]> gitweb.factorcode.org Git - factor.git/blobdiff - core/io/binary/binary.factor
use radix literals
[factor.git] / core / io / binary / binary.factor
old mode 100755 (executable)
new mode 100644 (file)
index f2ede93..793fe06
@@ -3,24 +3,31 @@
 USING: kernel math sequences ;
 IN: io.binary
 
-: le> ( seq -- x ) B{ } like byte-array>bignum >integer ;
-: be> ( seq -- x ) <reversed> le> ;
+: le> ( seq -- x ) dup length iota 0 [ 8 * shift + ] 2reduce ;
+: be> ( seq -- x ) 0 [ [ 8 shift ] dip + ] reduce ;
 
-: mask-byte ( x -- y ) HEX: ff bitand ; inline
+: mask-byte ( x -- y ) 0xff bitand ; inline
 
 : nth-byte ( x n -- b ) -8 * shift mask-byte ; inline
 
-: >le ( x n -- str ) [ nth-byte ] with B{ } map-as ;
-: >be ( x n -- str ) >le dup reverse-here ;
+: >le ( x n -- byte-array ) iota [ nth-byte ] with B{ } map-as ;
+: >be ( x n -- byte-array ) >le reverse! ;
 
 : d>w/w ( d -- w1 w2 )
-    dup HEX: ffffffff bitand
-    swap -32 shift HEX: ffffffff bitand ;
+    [ 0xffffffff bitand ]
+    [ -32 shift 0xffffffff bitand ] bi ;
 
 : w>h/h ( w -- h1 h2 )
-    dup HEX: ffff bitand
-    swap -16 shift HEX: ffff bitand ;
+    [ 0xffff bitand ]
+    [ -16 shift 0xffff bitand ] bi ;
 
 : h>b/b ( h -- b1 b2 )
-    dup mask-byte
-    swap -8 shift mask-byte ;
+    [ mask-byte ]
+    [ -8 shift mask-byte ] bi ;
+
+: signed-le> ( bytes -- x )
+    [ le> ] [ length 8 * 1 - 2^ 1 - ] bi
+    2dup > [ bitnot bitor ] [ drop ] if ;
+
+: signed-be> ( bytes -- x )
+    <reversed> signed-le> ;