source: project/wiki/eggref/4/bitstring @ 32494

== bitstring

== Description

Easy binary data manipulation.
Support binary encoding-decoding with matching and condition guards.
Implements the subset of Erlang bit syntax.

== Authors

rivo

== Requirements

No requiremtents. 

== API

== Basic syntax description

<enscript highlight="scheme">
(bitmatch binary-data
 ((pattern ...) expression)
 ...
 (else expression))

(bitconstruct
 pattern ...)
</enscript>
 
== Patterns description

;(NAME) : Read byte from stream and bind to variable NAME or compare with immediate value if name not a symbol name. Supported immediate values types: integer char string

;(NAME BITS) : Read n-BITS big endian unsigned integer, bind-or-compare to NAME.

;(NAME BITS [big | little | host] [signed | unsigned]) : {{BITS}} integer with byte-oreder and signed/usigned attirbutes.

;(NAME float [big | little | host]) : Read single precision floating point, bind-or-compare to NAME.

;(NAME double [big | little | host]) : Read double precision floating point, bind-or-compare to NAME.

;(NAME BITS float [big | little | host]) : Read 32/64 bits floating point value, bind-or-compare to NAME. Generic way to manipulate signle or double precision values.

;(NAME boolean) : Read 8 bit boolean, bind-or-compare to NAME, (#f - all bits zeroes or #t otherwise). 
;(NAME BITS boolean [big | little | host]) : Boolean maybe saved as arbitrary bits integer also with endian attribute. Saving boolen will turns NAME to 0 for #f, 1 for #t.

;(NAME BITS bitstring) : Read raw BITS from stream, bind-or-compare to NAME.

;(NAME bitstring) : Greedy read, consume all available bits.

;() : Empty bitstring

;(PACKET-NAME bitpacket) : Read a packet defined by the (bitpacket PACKET-NAME ...) declaration. Bind each packet field to current lexical scope. ''!!! bitpacket is an experimental feature !!!''

;(check EXPRESSION) : user guard EXPRESSION. Matching will continue only when this evaluates to a true value.

== Matching inputs against bit patterns

<macro>(bitmatch binary-data patterns-list else-guard)</macro>

* Match {{binary-data}} against the patterns from {{patterns-list}}.
* {{binary-data}} may be a bitstring object or a value of any of the following data types: u8vector, string or regular vector.
* If nothing matches and an {{else-guard}} clause was not specified, an exception of type {{bitstring-match-failure}} is raised.
* Else guard is optional. 

== Constructing bitstrings from input based on bit patterns

<macro>(bitconstruct pattern)</macro>

* Construct bitstring based on pattern.  The pattern will construct the bitstring from identifiers taken from the current lexical scope.
* If nothing matches an exception of type {{bitstring-match-failure}} is raised.
* Supports special pattern for concatenating bitstrings.

; ((EXPRESSION ...) bitstring) : EXPRESSION should evaluate to bitstring during constructing.

== Defining custom bitstring forms

<macro>(bitpacket PACKET-NAME fields ...)</macro>

Define well-known set of fields. Fields syntax the same as bitmatch pattern syntax.

== Dealing with bitstring objects

Bitstring objects represent strings of bits of arbitrary length.  This
means they can store any number of unaligned bits, rather like
bitfields in C.  Bitfields can also share memory with other bitfields,
which means you can easily create sub-bitstrings from other bitstrings.

<procedure>(bitstring=? bitstring1 bitstring2)</procedure>

Compare bitstrings.

<procedure>(bitstring-bit-set? bitstring bit-index)</procedure>

Test bit value at {{bit-index}} position. 

(bitstring-bit-set? (->bitstring '#${80 00}) 0) => #t
(bitstring-bit-set? (->bitstring '#${00 01}) -1) => #t

<procedure>(bitstring->list bitstring [bits [byte-order]])</procedure>

Convert bitstring to list of bits.

Optional group {{bits}}, default value 1, indicates how many bits each
entry in the list should span.  For example, to see the contents
grouped by octet, use 8 here.

Optional {{byte-order}} {{'little}} - little-endian, {{'big}} - big-endian,
{{'host}} host system byte-order, default value {{'big}}.  This has an effect only if {{bit}}
is larger than 8.

<procedure>(bitstring-reverse bitstring [bits [byte-order]])</procedure>

Reverse bitstring, optional group {{bits}} (default 1) with {{byte-order}} (default {{'big}}).

(bitstring-reverse (->bitstring '#${01 02}) 1) => #${40 80}

(bitstring-reverse (->bitstring '#${01 02}) 8 little) => #${02 01}

<procedure>(bitstring-not bitstring)</procedure>

Invert each bit value.

(bitstring-not (->bitstring '#${FE 00})) => #${01 FF}

<procedure>(bitstring? obj)</procedure>

Returns {{#t}} or {{#f}} depending on whether {{obj}} is a bitstring
or another type of object.

<procedure>(bitstring-length bitstring)</procedure>

Return length of the bitstring in bits.

<procedure>(bitstring-append bitstring1 bitstringN ...)</procedure>

Concatenate bitstrings.

<procedure>(bitstring-append! dest-bitstring bitstringN ...)</procedure>

Concatenate bitstrings, and store result into dest-bitstring.

<procedure>(->bitstring obj)</procedure>

Construct bitstring from arbitrary object.

<procedure>(vector->bitstring vec)</procedure>
Each element of vector {{vec}} should be integer in range of 0 - 255.

<procedure>(u8vector->bitstring vec)</procedure>
<procedure>(string->bitstring str)</procedure>

<procedure>(bitstring->blob bitstring [zero-extendind])</procedure>
<procedure>(bitstring->u8vector bitstring [zero-extendind])</procedure>

If bitstring not aligned on 8 bit boundary rest bits extending with zeroes.
{{zero-extendind}} optional argument, {{'left}} you get an integer value of rest bit,
{{'right}} give you internal bitstring repsesentation where bits follow one by one, default value {{'left}}.

zero-extending to left
<bitstring 0 9 (1 1 1 1 1 1 1 1 1)> turn into #u8(#xff #x01)

zero-extending to right, this might be usefull when you want to store your string to the disc and then load back.
<bitstring 0 9 (1 1 1 1 1 1 1 1 1)> turn into #u8(#xff #x80)

== Examples

<enscript highlight="scheme">

; Example 1. Tagged data structure.
;
; struct Tagged {
;  enum { IntegerType = 1, FloatType = 2 };
;  unsigned char Tag; // integer type = 1, float type = 2
;  union {
;   unsigned int IValue;
;   float FValue;
;  };
; };
;

(use bitstring)

; The following will print "integer:3721182122",
; which is the decimal value of #xDDCCBBAA
(bitmatch "\x01\xAA\xBB\xCC\xDD"
  (((#x01) (IValue 32 little))
      (print "integer:" IValue))
  (((#x02) (FValue 32 float))
      (print "float:" FValue)))

; Example 2. Fixed length string. 
;
; struct FixedString {
;  short Length; // length of StringData array
;  char StringData[0];
; };
;

(use bitstring)

; This will print "StringData:(65 66 67 68 69)"
; First it reads the length byte of 5, bind it to Length and
; then it will read a bit string with a length of that many octets.
(bitmatch "\x05\x00ABCDE"
  (((Length 16 little)
    (StringData (* 8 Length) bitstring))
      (print "StringData:" (bitstring->list StringData 8)))
  (else
      (print "invalid string")))

; Example 3. IP packet parsing. 
;

(use bitstring srfi-4)

(define IPRaw `#u8( #x45 #x00 #x00 #x6c
        #x92 #xcc #x00 #x00
        #x38 #x06 #x00 #x00
        #x92 #x95 #xba #x14
        #xa9 #x7c #x15 #x95 ))

(bitmatch IPRaw
  (((Version 4)
    (IHL 4)
    (TOS 8)
    (TL 16)
    (Identification 16)
    (Reserved 1) (DF 1) (MF 1)
    (FramgentOffset 13)
    (TTL 8)
    (Protocol 8) (check (or (= Protocol 1)
                            (= Protocol 2)
                            (= Protocol 6)
                            (= Protocol 17))) 
    (CheckSum 16)
    (SourceAddr 32 bitstring)
    (DestinationAddr 32 bitstring)
    (Optional bitstring))
      ; print packet filds
      (print "\n Version: " Version
             "\n IHL: " IHL
             "\n TOS: " TOS
             "\n TL:  " TL
             "\n Identification: " Identification
             "\n DF: " DF
             "\n MF: " MF
             "\n FramgentOffset: " FramgentOffset
             "\n Protocol: " Protocol
             "\n CheckSum: " CheckSum
             "\n SourceAddr: " 
                 (bitmatch SourceAddr (((A)(B)(C)(D)) (list A B C D)))
               "\n DestinationAddr: " 
                   (bitmatch DestinationAddr (((A)(B)(C)(D)) (list A B C D)))))
  (else
    (print "bad datagram")))

; Example 3.1 Using bitconstruct.

(define (construct-fixed-string str)
  (bitconstruct
    ((string-length str) 16) (str bitstring) ))

; The following will print "#t".  First, it reads a 16-bit number length
; and compares it to the immediate value of 7.  Then it will read a
; string and compare it to the immediate value of "qwerty.".  If there
; was any remaining data in the string, it would fail.
(bitmatch (construct-fixed-string "qwerty.")
  (((7 16) ("qwerty."))
    (print #t))
  (else 
    (print #f)))

; Example 3.2 Concatenating bitstrings.

(define (construct-complex-object)
  (bitconstruct
    ((construct-fixed-string "A") bitstring)
    (#xAABB 16)
    ((construct-fixed-string "RRR") bitstring)
    (#\X)))

(print (construct-complex-object))

; Basic TGA image parser.
; Support True-Image type format and Run-Length-Encoding compression.
; SPEC: http://www.dca.fee.unicamp.br/~martino/disciplinas/ea978/tgaffs.pdf
; Full Source: https://bitbucket.org/rivo/bitstring/src/tip/tests?at=default
;
; WARNING!!! bitpacket feature is experimental !!!
(use bitstring posix srfi-4)

(bitpacket TGA-Header
  (ID-length 8)
  (ColorMapType 8)
  (ImageType 8)
  (TGA-ColorMapSpec bitpacket)
  (TGA-ImageSpec bitpacket))

(bitpacket TGA-ColorMapSpec
  (FirstEntryIndex 16 little)
  (ColorMapLength 16 little)
  (ColorMapEntrySize 8))

(bitpacket TGA-ImageSpec
  (X-Origin 16 little)
  (Y-Origin 16 little)
  (ImageWidth 16 little)
  (ImageHeight 16 little)
  (PixelDepth 8)
  (ImageTransferOrder 2)
  (#x00 2) ; reserved
  (AttributesBitsPerPixel 4))

(define (parse-tga file file-out)
  (let* ((fi (file-open file (+ open/rdonly open/binary)))
         (fo (file-open file-out (+ open/write open/creat open/trunc open/binary)))
         (size (file-size fi))
         (res (file-read fi size))
         (data (car res)))
    (bitmatch data
      ; True-Color uncompressed
      (((TGA-Header bitpacket)
        (check (and (= 0 ColorMapType) (= 2 ImageType)))
        (ID-data ID-length bitstring)
        (Image-data (* ImageWidth ImageHeight PixelDepth) bitstring)
        (Rest-data bitstring))
                (begin
                  (print "True-Color uncompressed")
                  (print ImageWidth "x" ImageHeight "x" PixelDepth)
                  (parse-image-uncompressed
                    (lambda (color)
                      (file-write fo (bitstring->blob color)))
                    PixelDepth Image-data)))
      ; True-Color compressed
      (((TGA-Header bitpacket)
        (check (and (= 0 ColorMapType) (= 10 ImageType)))
        (ID-data ID-length bitstring)
        (Image-data bitstring))
                (begin
                  (print "True-Color compressed")
                  (print ImageWidth "x" ImageHeight "x" PixelDepth)
                  (parse-image-compressed
                      (lambda (color)
                        (file-write fo (bitstring->blob color)))
                      PixelDepth Image-data))))))

(define (parse-image-uncompressed func depth image)
  (bitmatch image
    ((())
        'ok)
    (((Color depth bitstring) (Rest bitstring))
      (begin
        (func Color)
        (parse-image-uncompressed func depth Rest)))))

(define (parse-image-compressed func depth image)
  (bitmatch image
    ((())
        'ok)
    (((1 1) (Count 7) (Color depth bitstring) (Rest bitstring))
        (let loop ((i 0))
          (func Color)
          (if (< i Count)
            (loop (+ i 1))
            (parse-image-compressed func depth Rest))))
    (((0 1) (Count 7) (RAW-data (* depth (+ Count 1)) bitstring) (Rest bitstring))
        (begin
          (parse-image-uncompressed func depth RAW-data)
          (parse-image-compressed func depth Rest)))))

; Convert images to raw pixels 
(parse-tga "tests/24compressed.tga" "tests/24c.raw")
(parse-tga "tests/24uncompressed.tga" "tests/24u.raw")

</enscript>

== License

BSD

== Repository

Bitstring is maintained in [[https://bitbucket.org/rivo/bitstring|a hg bitbucket repository]].

== Version History

1.34
Fix boolean parsing to support terms following boolean terms. (Jonathan Chan)

1.33
Fixed signed integers parsing.

Implemented boolean type.

New procs {{bitstring-bit-set?}} {{bitstring-reverse}} {{bitstring-not}}.

Removed support of half-float precision.

Implemented endian attribute for floating point types. Please note that now big-endian is defualt endianess for floating types, this can break or slowdonw your old code. Use "host" attribute to restore old behavior (VALUE float) -> (VALUE float host).


1.11
zero-extending option for bitstring->u8vector,bitstring->blob.
Multiple argument for bitstring-append.

1.1 Change a bit naming style. Speed-up with -O3 level compilation.

1.0
introduce bitstring-append, bitstring-append! 
fixed bug in bitstring-append size calculation (sjamaan)
native "host" endian byteorder (sjamaan)
signed/unsigned integer attributes

0.5
Restore (check EXPRESSION) syntax, cause this is not same as matchable (?)
bytestring? function check if string is byte aligned.
bytestring-fold helper function.

0.4
Multiline user expressions. Bitconstruct now accept only single pattern. bitstring-compare renamed to bitstring=?. Optimized immidiate value macro expansion. (check EXPRESSION) guard renamed to (? EXPRESSION).
 
0.3
install bugfixes

0.2
introduce bitconstruct

0.1
first public release