#! perl -slw
use strict;
use Inline C => Config => BUILD_NOISY => 1;
use Inline C => <<'END_C',  NAME => '_24to32', CLEAN_AFTER_BUILD => 0;

#define IS_VARS Inline_Stack_Vars
#define IS_RESET Inline_Stack_Reset
#define IS_PUSHIV( iv ) Inline_Stack_Push( sv_2mortal( newSViv( iv ) ) )
#define IS_PUSHUV( uv ) Inline_Stack_Push( sv_2mortal( newSVuv( uv ) ) )
#define IS_DONE Inline_Stack_Done

typedef union {
    unsigned int packed;
    struct { unsigned e :8, d :6, c :6, b :6, a :6; } u;
} _4BY6;

void _24to32( SV* packed ) {
    IS_VARS;
    char *pp = SvPVX( packed );
    _4BY6 up;
    int i;

    IS_RESET;
    for( i=0; i<24; i+=3 ) {
        up.packed = _byteswap_ulong( *(unsigned long*)&pp[ i ] );
        IS_PUSHUV( up.u.a );
        IS_PUSHUV( up.u.b );
        IS_PUSHUV( up.u.c );
        IS_PUSHUV( up.u.d );
    }
    IS_DONE;
    return;
}

void _24to32_2( SV *packed ) {
    IS_VARS;
    char *pp = SvPVX( packed );
    int i;

    IS_RESET;
    for( i=0; i<24; i+=3 ) {
        unsigned int n = _byteswap_ulong( *(unsigned long*)&pp[ i -1 ] );
        IS_PUSHUV( ( n & 0xfc0000 ) >> 18 );
        IS_PUSHUV( ( n & 0x03f000 ) >> 12 );
        IS_PUSHUV( ( n & 0x000fc0 ) >>  6 );
        IS_PUSHUV( ( n & 0x00003f )       );
    }
    IS_DONE;
    return;

}

void roboticus( SV *packed ) {
    IS_VARS;
    unsigned char *src = SvPVX( packed );
    unsigned char *srcEnd = src + 24;
    int rem = 0;
    int st = 0;

    IS_RESET;
    while (src != srcEnd) {
        switch (st) {
        case 0:
            IS_PUSHUV( ( *src & 0xfc ) >> 2 );
            rem = ( *src++ & 0x03 ) << 4;
            st = 1;
        break;
        case 1:
            IS_PUSHUV( ( ( *src & 0xf0 ) >> 4 ) | rem );
            rem = ( *src++ & 0x0f ) << 2;
            st = 2;
        break;
        case 2:
            IS_PUSHUV( ( ( *src & 0xc0 ) >> 6 ) | rem );
            IS_PUSHUV( *src++ & 0x3f );
            st = 0;
        break;
        }
    }
    IS_DONE;
    return;
}

END_C

use Math::Random::MT qw[ rand srand ];
use Benchmark qw[ cmpthese ];

sub buk {
    map ord( pack 'B8', '00'.$_ ), unpack '(a6)*', unpack 'B*', $_[0];
}

sub jethro {
    use constant {
        B1N1 => [ map{ ($_) x 4 } 0 .. 63 ],
        B1N2 => [ ( 0, 16, 32, 48 ) x 64 ],
        B2N1 => [ map{ ($_) x 16 } 0 .. 15 ],
        B2N2 => [ ( 0,4,8,12,16,20,24,28,32,36,40,44,48,52,56,60, ) x 16 ],
        B3N1 => [ map{ ( $_ ) x 64 } 0 .. 63 ],
        B3N2 => [ ( 0 .. 63 ) x 4 ],
    };
    map {
        my( $b1, $b2, $b3 ) = unpack 'C3', $_;
        B1N1->[ $b1 ],
        B1N2->[ $b1 ] + B2N1->[ $b2 ],
        B2N2->[ $b2 ] + B3N1->[ $b3 ],
        B3N2->[ $b3 ]
    } unpack '(a3)8', $_[0];
}

sub jmcnamara {
    use constant MASK00_05 => 2**6 - 1;
    use constant {
        MASK06_11 => MASK00_05 <<  6,
        MASK12_17 => MASK00_05 << 12,
        MASK18_23 => MASK00_05 << 18,
    };
    map {
        $_ = unpack 'N', chr(0) . $_;
        ( $_ & MASK18_23 ) >> 18,
        ( $_ & MASK12_17 ) >> 12,
        ( $_ & MASK06_11 ) >>  6,
          $_ & MASK00_05,
    } unpack '(a3)8', $_[0]
}

sub salva {
    use constant {
        SALVA => { 
            map{ sprintf( "%03x", $_ ) => [ ( $_ & 0xfc0 )>>6, $_ & 0x3f ] }0..4095 
        },
    };
    map @{ SALVA->{ $_ } }, unpack '(a3)*', unpack 'H*', $_[0];
}

## 32 6-bit values (0..31) packed as 24-bytes.
our  $packed = pack 'C*', qw[
     00 16 131 16 81 135 32 146 139  48 211 143 
     65 20 147 81 85 151 97 150 155 113 215 159
];

print join ' ', map sprintf( "%02d", $_ ),       buk( $packed );
print join ' ', map sprintf( "%02d", $_ ),    jethro( $packed );
print join ' ', map sprintf( "%02d", $_ ), jmcnamara( $packed );
print join ' ', map sprintf( "%02d", $_ ),     salva( $packed );
print join ' ', map sprintf( "%02d", $_ ),   _24to32( $packed );
print join ' ', map sprintf( "%02d", $_ ), roboticus( $packed );
print join ' ', map sprintf( "%02d", $_ ), _24to32_2( $packed );

cmpthese -1, {
    buk       => q[ my @smalls = buk(       $packed ) ],
    jethro    => q[ my @smalls = jethro(    $packed ) ],
    jmcnamara => q[ my @smalls = jmcnamara( $packed ) ],
    salva     => q[ my @smalls = salva(     $packed ) ],
    C_24to32  => q[ my @smalls = _24to32(   $packed ) ],
    Croboticus=> q[ my @smalls = roboticus( $packed ) ],
    C_24to32_2=> q[ my @smalls = _24to32_2( $packed ) ],
};