extra/io/binary/fast/fast.factor

   1 ! Copyright (C) 2011 Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: alien.c-types alien.data byte-arrays combinators
   4 combinators.smart endian fry hints kernel locals macros math
   5 math.ranges sequences sequences.generalizations ;
   6 RENAME: be> io.binary => slow-be>
   7 RENAME: le> io.binary => slow-le>
   8 RENAME: signed-be> io.binary => slow-signed-be>
   9 RENAME: signed-le> io.binary => slow-signed-le>
  10 RENAME: >be io.binary => >slow-be
  11 RENAME: >le io.binary => >slow-le
  12 IN: io.binary.fast
  13
  14 ERROR: bad-length bytes n ;
  15
  16 : check-length ( bytes n -- bytes n )
  17     2dup [ length ] dip > [ bad-length ] when ; inline
  18
  19 <<
  20 : be-range ( n -- range )
  21     1 - 8 * 0 -8 <range> ; inline
  22
  23 : le-range ( n -- range )
  24     1 - 8 * 0 swap 8 <range> ; inline
  25
  26 : reassemble-bytes ( range -- quot )
  27     [ [ [ ] ] [ '[ _ shift ] ] if-zero ] map
  28     '[ [ _ spread ] [ bitor ] reduce-outputs ] ; inline
  29
  30 MACRO: reassemble-be ( n -- quot ) be-range reassemble-bytes ;
  31
  32 MACRO: reassemble-le ( n -- quot ) le-range reassemble-bytes ;
  33 >>
  34
  35 :: n-be> ( bytes n -- x )
  36     bytes n check-length drop n firstn-unsafe n reassemble-be ; inline
  37
  38 :: n-le> ( bytes n -- x )
  39     bytes n check-length drop n firstn-unsafe n reassemble-le ; inline
  40
  41 HINTS: n-be> { byte-array object } ;
  42 HINTS: n-le> { byte-array object } ;
  43
  44 <PRIVATE
  45 : if-endian ( endian bytes-quot seq-quot -- )
  46     [
  47         compute-native-endianness =
  48         [ dup byte-array? ] [ f ] if
  49     ] 2dip if ; inline
  50 PRIVATE>
  51
  52 : 2be> ( bytes -- x )
  53     big-endian [ uint16_t deref ] [ 2 n-be> ] if-endian ;
  54
  55 : 4be> ( bytes -- x )
  56     big-endian [ uint32_t deref ] [ 4 n-be> ] if-endian ;
  57
  58 : 8be> ( bytes -- x )
  59     big-endian [ uint64_t deref ] [ 8 n-be> ] if-endian ;
  60
  61 : be> ( bytes -- x )
  62     dup length {
  63         { 2 [ 2be> ] }
  64         { 4 [ 4be> ] }
  65         { 8 [ 8be> ] }
  66         [ drop slow-be> ]
  67     } case ;
  68
  69 : signed-be> ( bytes -- x )
  70     compute-native-endianness big-endian = [
  71         dup byte-array? [
  72             dup length {
  73                 { 2 [ int16_t deref ] }
  74                 { 4 [ int32_t deref ] }
  75                 { 8 [ int64_t deref ] }
  76                 [ drop slow-signed-be> ]
  77             } case
  78         ] [ slow-signed-be> ] if
  79     ] [ slow-signed-be> ] if ;
  80
  81 : 2le> ( bytes -- x )
  82     little-endian [ uint16_t deref ] [ 2 n-le> ] if-endian ;
  83
  84 : 4le> ( bytes -- x )
  85     little-endian [ uint32_t deref ] [ 4 n-le> ] if-endian ;
  86
  87 : 8le> ( bytes -- x )
  88     little-endian [ uint64_t deref ] [ 8 n-le> ] if-endian ;
  89
  90 : le> ( bytes -- x )
  91     dup length {
  92         { 2 [ 2le> ] }
  93         { 4 [ 4le> ] }
  94         { 8 [ 8le> ] }
  95         [ drop slow-le> ]
  96     } case ;
  97
  98 : signed-le> ( bytes -- x )
  99     compute-native-endianness little-endian = [
 100         dup byte-array? [
 101             dup length {
 102                 { 2 [ int16_t deref ] }
 103                 { 4 [ int32_t deref ] }
 104                 { 8 [ int64_t deref ] }
 105                 [ drop slow-signed-le> ]
 106             } case
 107         ] [ slow-signed-le> ] if
 108     ] [ slow-signed-le> ] if ;
 109
 110 : >le ( x n -- bytes )
 111     compute-native-endianness little-endian = [
 112         {
 113             { 2 [ int16_t <ref> ] }
 114             { 4 [ int32_t <ref> ] }
 115             { 8 [ int64_t <ref> ] }
 116             [ >slow-le ]
 117         } case
 118     ] [ >slow-le ] if ;
 119
 120 : >be ( x n -- bytes )
 121     compute-native-endianness big-endian = [
 122         {
 123             { 2 [ int16_t <ref> ] }
 124             { 4 [ int32_t <ref> ] }
 125             { 8 [ int64_t <ref> ] }
 126             [ >slow-be ]
 127         } case
 128     ] [ >slow-be ] if ;