extra/leb128/leb128.factor

   1 ! Copyright (C) 2023 John Benediktsson
   2 ! See https://factorcode.org/license.txt for BSD license
   3
   4 USING: byte-vectors combinators.short-circuit io
   5 io.streams.byte-array kernel math namespaces sequences ;
   6
   7 IN: leb128
   8
   9 ! Unsigned LEB128
  10
  11 <PRIVATE
  12
  13 :: (write-uleb128) ( n quot: ( b -- ) -- )
  14     n assert-non-negative [
  15         [ -7 shift dup ] [ 0x7f bitand ] bi :> ( i b )
  16         dup zero? [ f b ] [ t b 0x80 bitor ] if
  17         quot call
  18     ] loop drop ; inline
  19
  20 PRIVATE>
  21
  22 : stream-write-uleb128 ( n stream -- )
  23     '[ _ stream-write1 ] (write-uleb128) ;
  24
  25 : write-uleb128 ( n -- )
  26     output-stream get stream-write-uleb128 ;
  27
  28 : >uleb128 ( n -- byte-array )
  29     16 <byte-vector> clone [
  30         '[ _ push ] (write-uleb128)
  31     ] keep B{ } like ;
  32
  33 :: stream-read-uleb128 ( stream -- n )
  34     0 0 [
  35         stream stream-read1 :> ( i b )
  36         b 0x7f bitand i 7 * shift +
  37         i 1 + b 7 bit?
  38     ] loop drop ;
  39
  40 : read-uleb128 ( -- n )
  41     input-stream get stream-read-uleb128 ;
  42
  43 : uleb128> ( byte-array -- n )
  44     0 byte-reader boa stream-read-uleb128 ;
  45
  46 ! Signed LEB128
  47
  48 <PRIVATE
  49
  50 :: (write-leb128) ( n quot: ( b -- ) -- )
  51     n [
  52         [ -7 shift dup ] [ 0x7f bitand ] bi :> ( i b )
  53         {
  54             [ i zero? b 6 bit? not and ]
  55             [ i -1 = b 6 bit? and ]
  56         } 0|| [ f b ] [ t b 0x80 bitor ] if
  57         quot call
  58     ] loop drop ; inline
  59
  60 PRIVATE>
  61
  62 : stream-write-leb128 ( n stream -- )
  63     '[ _ stream-write1 ] (write-leb128) ;
  64
  65 : write-leb128 ( n -- )
  66     output-stream get stream-write-leb128 ;
  67
  68 : >leb128 ( n -- byte-array )
  69     16 <byte-vector> clone [
  70         '[ _ push ] (write-leb128)
  71     ] keep B{ } like ;
  72
  73 :: stream-read-leb128 ( stream -- n )
  74     0 0 [
  75         stream stream-read1 :> ( i b )
  76         b 0x7f bitand i 7 * shift +
  77         i 1 + b 7 bit? dup [
  78             b 6 bit? [
  79                 [ [ 7 * 2^ neg bitor ] keep ] dip
  80             ] when
  81         ] unless
  82     ] loop drop ;
  83
  84 : read-leb128 ( -- n )
  85     input-stream get stream-read-leb128 ;
  86
  87 : leb128> ( byte-array -- n )
  88     0 byte-reader boa stream-read-leb128 ;