Article 3459 of comp.lang.perl:
Xref: feenix.metronet.com comp.lang.perl:3459
Newsgroups: comp.lang.perl
Path: feenix.metronet.com!news.utdallas.edu!tamsun.tamu.edu!cs.utexas.edu!swrinde!elroy.jpl.nasa.gov!ufo!hobbs!dnoble
From: dnoble@devvax.jpl.nasa.gov (David Noble)
Subject: Re: How to pack/unpack bits?
Message-ID: <1993Jun16.164149.26542@jpl-devvax.jpl.nasa.gov>
Originator: dnoble@hobbs
Sender: usenet@jpl-devvax.jpl.nasa.gov (For NNTP so rrn will be able to post)
Nntp-Posting-Host: hobbs
Organization: Jet Propulsion Laboratory (NASA)
References: <1993Jun16.140220.6372@prl.philips.nl>
Date: Wed, 16 Jun 1993 16:41:49 GMT
Lines: 212

niekerk@prl.philips.nl (Paul van Niekerk) writes:
> it seems that all bit fields start at byte boundaries.
yep

> Can the above structure be handled by pack/unpack?
nope

The following routines will give you the pack/unpack behavior you want,
as long as each collection of bitfields fits evenly into an 8, 16, or
32-bit block. I've never really had any use for templates using 'b'
(lsb first), so it may break on them. I always use 'B' (msb first).
Somebody let me know if there's an easy way to do this. This algorithm
was coded for "programmer efficiency" according to the camel book definition,
meaning 'use whatever you think of first'.

Hope this helps...

David Noble (dnoble@devvax.jpl.nasa.gov)

----SNIP----SNIP----SNIP----SNIP----SNIP----SNIP----SNIP----SNIP----SNIP----

;# USAGE
;#	$data = &pack('B3B5nAA', @fields);
;#	@fields = &unpack('B3B5nAA', $data);

sub pack {
  local ($template) = shift(@_);
  local (@data) = @_;
  local ($_);
  local ($type, $len);
  local ($new_tmplt);
  local ($new_field);
  local ($current_bits);
  local ($wrapup);
  local (@tmp_data);

  # see if the template has any bitfields (they make life difficult)
  if ($template =~ m/[Bb]/) {
    $_ = $template;

    # check each field, in order
    while (($type, $len) = m/([A-Za-z])([0-9*]*)/) {
      s/[A-Za-z][0-9*]*//;

      # see if this is one of those nasty bitfields
      if (($type eq 'b') || ($type eq 'B')) {
	if (!$len) { $len = 1; } # accept 'B' as 'B1'

	$current_bits += $len;
	$new_field .= shift(@data);

	if (($current_bits == 8) || ($current_bits == 16)
		|| ($current_bits == 32))
	{
	  $new_tmplt .= $type . $current_bits;
	  push(@tmp_data, $new_field);
	  $current_bits = 0;
	  $new_field = '';
	}
	elsif ($current_bits > 32) {
	  die 'bitfields must at least be aligned on 32-bit words, stopped';
	}
      } # end of processing bit fields

      elsif ($current_bits) {
	  die 'fields must at least be aligned on 32-bit words, stopped';
      }

      # this was not a bitfield, so it gets passed through to the new template
      else {
        push(@tmp_data, shift(@data));
	$new_tmplt .= $type . $len;
      }
    }

    pack($new_tmplt, @tmp_data);

  }

  # this is how easy it is without bitfields
  else {
    pack($template, @data);
  }
}

sub unpack {
  local ($template) = shift(@_);
  local ($data) = shift(@_);
  local ($_);
  local ($i);
  local ($type, $len);
  local ($pos);
  local ($new_tmplt);
  local ($wrapup);
  local ($current_bits);
  local ($next_bitfield);
  local ($field_with_bits);
  local ($bits_left);
  local ($tmp_field);
  local (@bitfields, @tmp_fields, @unfinished, @return);

  # see if the template has any bitfields (they make life difficult)
  if ($template =~ m/[Bb]/) {
    $_ = $template;

    # check each field, in order
    while (($type, $len) = m/([A-Za-z])([0-9*]*)/) {
      s/[A-Za-z][0-9*]*//;

      # see if this is one of those nasty bitfields
      if (($type eq 'b') || ($type eq 'B')) {
	if (!$len) { $len = 1; } # accept 'B' as 'B1'
	push(@tmp_fields, $len);	# keep track of the number of bits

	# append this to any previous adjacent bitfield that is unaligned
	$current_bits += $len;
	if ($current_bits == 8) {
	  $new_tmplt .= 'C';
	  $wrapup = 1;
	}
	elsif ($current_bits == 16) {
	  $new_tmplt .= 'n';
	  $wrapup = 1;
	}
	elsif ($current_bits == 32) {
	  $new_tmplt .= 'N';
	  $wrapup = 1;
	}
	elsif ($current_bits > 32) {
	  die 'bitfields must at least be aligned on 32-bit words, stopped';
	}

	#
	# Store the location of the collection of bitfields,
	# the aggregate size of the contiguous bitfields, and
	# IN REVERSE ORDER the size of each bitfield.
	#
	# This reverse order makes it a _lot_ easier to extract
	# the individual bitfields from the conglomerate. But,
	# it does make another layer of reversing necessary to
	# have the bitfields end up in the right order in the
	# final returned list.
	#
	if ($wrapup) {
	  push(@bitfields, $pos);
	  push(@bitfields, $current_bits);
	  while (@tmp_fields) {
	    push(@bitfields, pop(@tmp_fields)); # note the backwards order
	  }
	  ++$pos;
	  $current_bits = 0;
	  $wrapup = 0;
	}
      } # end of processing bit fields

      elsif ($current_bits) {
	  die 'fields must at least be aligned on 32-bit words, stopped';
      }

      # this was not a bitfield, so it gets passed through to the new template
      else {
        ++$pos;
	$new_tmplt .= $type . $len;
      }
    }

    #
    # the new template has been constructed, so unpack the structure
    #

    @unfinished = unpack($new_tmplt, $data);

    #
    # now find the bitfields and put them into the return list
    #

    $pos = 0;
    $next_bitfield = shift(@bitfields);

    while (@unfinished) {
      if ($pos == $next_bitfield) {
	$field_with_bits = shift(@unfinished);
        $bits_left = shift(@bitfields);

	while ($bits_left) {
          $len = shift(@bitfields);
	  for ($tmp_field = '', $i = 0; $i < $len; ++$i) {
	    $tmp_field = (($field_with_bits & 1) ? '1' : '0') . $tmp_field;
	    $field_with_bits = $field_with_bits >> 1;
	  }
	  push(@tmp_fields, $tmp_field);
	  $bits_left -= $len;
	}

	while (@tmp_fields) { push(@return, pop(@tmp_fields)); }
        $next_bitfield = shift(@bitfields);
      }
      else {
	push(@return, shift(@unfinished));
	++$pos;
      }
    }
    @return;
  }

  # this is how easy it is without bitfields
  else {
    unpack($template, $data);
  }
}

1;


Article 3465 of comp.lang.perl:
Xref: feenix.metronet.com comp.lang.perl:3465
Path: feenix.metronet.com!news.ecn.bgu.edu!mp.cs.niu.edu!ux1.cso.uiuc.edu!uwm.edu!cs.utexas.edu!utnut!utcsri!csri.toronto.edu!acs
Newsgroups: comp.lang.perl
From: acs@csri.toronto.edu (Alvin Chia-Hua Shih)
Subject: Re: How to pack/unpack bits?
Message-ID: <1993Jun16.133329.8754@jarvis.csri.toronto.edu>
References: <1993Jun16.140220.6372@prl.philips.nl>
Date: 16 Jun 93 17:33:30 GMT
Lines: 19

In <1993Jun16.140220.6372@prl.philips.nl> niekerk@prl.philips.nl (Paul van Niekerk) writes:
		[ structure diagram elided... ]

>it seems that all bit fields start at byte boundaries. I can't find any
>examples of packing/unpacking bits in the Camel book. Can the above 
>structure be handled by pack/unpack? How?

Nope.  Pack and unpack are for byte-sized thingies or bigger.  What you
need is the vec() operator.  Have a look at the entry in the manpage.

The thing to note is that a vec() can be an lvalue.

ACS
-- 
 ___ ___ ___ ______________________________________________________________
|   |   | __|      Democracy is not a way of getting better solutions.     |
| - | --|__ |           It's just a way to spread the blame.               |
|_|_|___|___|______________________________________________________________|
Alvin_C._Shih____________________acs@csri.utoronto.ca______________________|


Hi there,

your perl archive has under the "Assorted" scripts the unpack_bitfields.pl
originally written by David Noble. I have modified his code as it had
some idiosyncracies(sp?) depending on his type of application. I have
generally cleaned it up and made it work with real binary data
(his unpack version required the data to already be textualised to ASCII 1
and 0, while his pack worked with real binary)..

David gave me permission to redistribute this. This will (hopefully)
also be part of the nocol distribution, as I used it to write my ntpmon
monitor...

Maybe you could add it to the archive.

Thx

here it is:


;# unpack-bitfields.pl
;# 	original by David Noble
;#	changes for real binary date in unpack plus minor changes
;#	by Mathias Koerber

;# USAGE
;#	$data = &bitpack('B3B5nAA', @fields);
;#	@fields = &bitunpack('B3B5nAA', $data);

sub bitpack {
  local ($template) = shift(@_);
  local (@data) = @_;
  local ($_);
  local ($type, $len);
  local ($new_tmplt);
  local ($new_field);
  local ($current_bits);
  local ($wrapup);
  local (@tmp_data);

  # see if the template has any bitfields (they make life difficult)
  if ($template =~ m/[Bb]/) {
    $_ = $template;

    # check each field, in order
    while (($type, $len) = m/([A-Za-z])([0-9*]*)/) {
      s/[A-Za-z][0-9*]*//;

      # see if this is one of those nasty bitfields
      if (($type eq 'b') || ($type eq 'B')) {
	if (!$len) { $len = 1; } # accept 'B' as 'B1'

	$current_bits += $len;
	$new_field .= shift(@data);

	if (($current_bits == 8) || ($current_bits == 16)
		|| ($current_bits == 32))
	{
          if ($current_bits == 8)  { $new_tmplt .= 'C'; };
          if ($current_bits == 16) { $new_tmplt .= 'I'; };
          if ($current_bits == 32) { $new_tmplt .= 'L';  };
		
	  push(@tmp_data, oct($new_field));
	  $current_bits = 0;
	  $new_field = '';
	}
	elsif ($current_bits > 32) {
	  die 'bitfields must at least be aligned on 32-bit words, stopped';
	}
      } # end of processing bit fields

      elsif ($current_bits) {
	  die 'fields must at least be aligned on 32-bit words, stopped';
      }

      # this was not a bitfield, so it gets passed through to the new template
      else {
        push(@tmp_data, shift(@data));
	$new_tmplt .= $type . $len;
      }
    }

    pack($new_tmplt, @tmp_data);

  }

  # this is how easy it is without bitfields
  else {
    pack($template, @data);
  }
}

sub bitunpack {
  local ($template) = shift(@_);
  local ($data) = shift(@_);
  local ($_);
  local ($i);
  local ($type, $len);
  local ($pos);
  local ($new_tmplt);
  local ($wrapup);
  local ($current_bits);
  local ($next_bitfield);
  local ($field_with_bits);
  local ($bits_left);
  local ($tmp_field);
  local (@bitfields, @tmp_fields, @unfinished, @return);

  # see if the template has any bitfields (they make life difficult)
  if ($template =~ m/[Bb]/) {
    $_ = $template;

    # check each field, in order
    while (($type, $len) = m/([A-Za-z])([0-9*]*)/) {
      s/[A-Za-z][0-9*]*//;

      # see if this is one of those nasty bitfields
      if (($type eq 'b') || ($type eq 'B')) {
	if (!$len) { $len = 1; } # accept 'B' as 'B1'
	push(@tmp_fields, $len);	# keep track of the number of bits

	# append this to any previous adjacent bitfield that is unaligned
	$current_bits += $len;
	if ($current_bits == 8) {
	  $new_tmplt .= 'C';
	  $wrapup = 1;
	}
	elsif ($current_bits == 16) {
	  $new_tmplt .= 'n';
	  $wrapup = 1;
	}
	elsif ($current_bits == 32) {
	  $new_tmplt .= 'N';
	  $wrapup = 1;
	}
	elsif ($current_bits > 32) {
	  die 'bitfields must at least be aligned on 32-bit words, stopped';
	}

	#
	# Store the location of the collection of bitfields,
	# the aggregate size of the contiguous bitfields, and
	# IN REVERSE ORDER the size of each bitfield.
	#
	# This reverse order makes it a _lot_ easier to extract
	# the individual bitfields from the conglomerate. But,
	# it does make another layer of reversing necessary to
	# have the bitfields end up in the right order in the
	# final returned list.
	#
	if ($wrapup) {
	  push(@bitfields, $pos);
	  push(@bitfields, $current_bits);
	  while (@tmp_fields) {
	    push(@bitfields, pop(@tmp_fields)); # note the backwards order
	  }
	  ++$pos;
	  $current_bits = 0;
	  $wrapup = 0;
	}
      } # end of processing bit fields

      elsif ($current_bits) {
	  die 'fields must at least be aligned on 32-bit words, stopped';
      }

      # this was not a bitfield, so it gets passed through to the new template
      else {
        ++$pos;
	$new_tmplt .= $type . $len;
      }
    }

    #
    # the new template has been constructed, so unpack the structure
    #

    @unfinished = unpack($new_tmplt, $data);

    #
    # now find the bitfields and put them into the return list
    #

    $pos = 0;
    $next_bitfield = shift(@bitfields);

    while (@unfinished) {
      if ($pos == $next_bitfield) {
	$field_with_bits = shift(@unfinished);
        $bits_left = shift(@bitfields);

	while ($bits_left) {
          $len = shift(@bitfields);
#	  for ($tmp_field = '', $i = 0; $i < $len; ++$i) {
#	    $tmp_field = (($field_with_bits & 1) ? '1' : '0') . $tmp_field;
#           $tmp_field += ($field_with_bits & 1);
#           $tmp_field >> 1;
#	    $field_with_bits = $field_with_bits >> 1;
#	    }
 	  $tmp_field = ($field_with_bits & ((2**$len)-1));
          $field_with_bits = $field_with_bits >> $len;
#	  $tmp_field << 1;	# correct for the last shift
	  push(@tmp_fields, $tmp_field);
	  $bits_left -= $len;
	}

	while (@tmp_fields) { push(@return, pop(@tmp_fields)); }
        $next_bitfield = shift(@bitfields); $pos++;
      }
      else {
	push(@return, shift(@unfinished));
	++$pos;
      }
    }
    @return;
  }

  # this is how easy it is without bitfields
  else {
    unpack($template, $data);
  }
}

1;

-- 
Mathias Koerber at SWi                                 Tel: +65 / 7780066 x 29
14 Science Park Drive                                       Fax: +65 / 7779401
#04-01 The Maxwell                           email: Mathias.Koerber@SWi.com.sg
Singapore Science Park
S'pore 0511         <A HREF=http://www.SWi.com.sg/~mathias/mathias.html>MK</A>
* Eifersucht ist eine Leidenschaft,  die mit Eifer sucht, was Leiden schafft *