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