Perl で unpack_bits

Perl の unpack では、ビット表現つまり 2 進数にするための B や b が使える。が、…使えてねぇ！

例えば、

my ($mapper, $four_screen, $trainer, $sram, $vertical_mirror)
  =  unpack("B4BBBB", $ines_flags);
  
で、$ines_flags には 0x43 でも入ってるとしよう。すると、欲しい値は (4, 0, 0, 1, 1) だ。が、返ってくる値は ("0011", "0", undef, undef, undef) になる。

は？

驚くべきこと、その１。unpack("B") 系は、数値ではなく、ビットの「文字列」を返す。

驚くべきこと、その２。unpack("B") 系の一つの B は必ず 1 バイトにしか対応しない。0x43 == 67 なので、ord('6') == 0b00110110 の 0011 と ord('7') == 0b00110111 の 0 が返ってきたわけだ。

先に pack("C") をしなかったのは私のミスだ。それは認めよう。でも、そうして返ってくるのは ("0100", undef, undef, undef, undef) になる。そんなの欲しかったわけじゃない！

ということで、上でしたかったように書く正解は次になる。

my ($mapper, $four_screen, $trainer, $sram, $vertical_mirror)
  =  map {unpack("C", pack("b" . length($_), scalar reverse($_)))}
        unpack("a4aaaa", unpack("B8", pack("C", $ines_flags)))); # Crazy!
        
あかん。これはあかん。ということで最初に書いたみたいに動く関数 unpack_bits を書いた。これだと、↓で OK。

my ($mapper, $four_screen, $trainer, $sram, $vertical_mirror)
  = unpack_bits("B4BBBB", $ines_flags);
  
ソースは↓。もちろんパブリックドメインで。もっといい書き方があるかもしれないけど…。

  sub unpack_bits {
    my ($origspec, $origbits) = @_;
    my @r;
    my $c = "B";
    my $len = 0;
    my $spec = reverse($origspec);
    my $bits = $origbits;
    while ($spec ne "") {
      my $n = 1;
      if ($spec =~ s/^[01-9]+//) {
        $n = reverse($&);
      }
      $spec =~ s/^.//;
      if ($& eq "b") {
        $c = "b";
      }
      push(@r, $bits & ((1 << $n) - 1));
      $bits = $bits >> $n;
      $len += $n;
    }
    if ($c ne "b") {
      return reverse @r;
    }
    @r = ();
    $spec = $origspec;
    $bits = $origbits;
    while ($spec ne "") {
      my $n = 1;
      my $c = "B";
      if ($spec =~ s/^[^01-9]//) {
        $c = $&;
      }
      if ($spec =~ s/^[01-9]+//) {
        $n = $&;
      }
      if ($c eq "b") {
        push(@r, $bits & ((1 << $n) - 1));
        $bits = $bits >> $n;
      } else {
        push(@r, ($bits >> ($len - $n)) & ((1 << $n) - 1));
      }
      $len -= $n;
    }
    return @r;
  }
  
  sub pack_bits {
    my ($spec, @bits) = @_;
    my @r;
    my $len = 0;
    my $bits = 0;
    while (@bits) {
      my $b = shift(@bits);
      my $n = 1;
      my $c = "B";
      if ($spec =~ s/^[^01-9]//) {
        $c = $&;
      }
      if ($spec =~ s/^[01-9]+//) {
        $n = $&;
      }
      $b = $b & ((1 << $n) - 1);
      if ($c eq "b") {
        $bits = $bits | ($b << $len);
      } else {
        $bits = ($bits << $n) | $b;
      }
      $len += $n;
    }
    return $bits;
  }
  
■参考
  ●《INES - Nesdev wiki》。ある意味広く普及した LLVM の一種としてファミコンエミュレータに注目。
  ●《Perl の数値変換》。＞憤慨するかもしれません。しかしその前に、自分は Perl に苦手な仕事をさせようとしていないか、ちょっと考えてみて下さい。 ＜sed や awk の流れで perl を見ればそうなるけど…。もう Perl で文字列処理に限定される使われかたじゃないし…。
  ●《perl - Can you explain the bits I'm getting from unpack? - Stack Overflow》。
    
更新：2014-03-05
初公開：2014年03月05日 06:24:44
最新版：2014年03月05日 06:24:44

Links:

INES - Nesdev wiki: http://wiki.nesdev.com/w/index.php/INES
Perl の数値変換: http://mikeneko.creator.club.ne.jp/~lab/perl/numerical_transform/
perl - Can you explain the bits I'm getting from unpack? - Stack Overflow: http://stackoverflow.com/questions/5749241/can-you-explain-the-bits-im-getting-from-unpack