http://www.perlmonks.org?node_id=234554

BrowserUk has asked for the wisdom of the Perl Monks concerning the following question:

I converting a peice of C source to Perl. The C has the following construct

switch(len) { case 11: c+=((unsigned int)k[10]<<24); case 10: c+=((unsigned int)k[9]<<16); case 9 : c+=((unsigned int)k[8]<<8); case 8 : b+=((unsigned int)k[7]<<24); case 7 : b+=((unsigned int)k[6]<<16); case 6 : b+=((unsigned int)k[5]<<8); case 5 : b+=k[4]; case 4 : a+=((unsigned int)k[3]<<24); case 3 : a+=((unsigned int)k[2]<<16); case 2 : a+=((unsigned int)k[1]<<8); case 1 : a+=k[0]; /* case 0: nothing left to add */ }

I've elected (for now) to translate this as

goto 'LAST'.$len; LAST11: $c+= $k[10] <<24; LAST10: $c+= $k[9] <<16; LAST9: $c+= $k[8] <<8; LAST8: $b+= $k[7] <<24; LAST7: $b+= $k[6] <<16; LAST6: $b+= $k[5] <<8; LAST5: $b+= $k[4]; LAST4: $a+= $k[3] <<24; LAST3: $a+= $k[2] <<16; LAST2: $a+= $k[1] <<8; LAST1: $a+= $k[0]; LAST0:

Any offers for a better translation?


Examine what is said, not who speaks.

The 7th Rule of perl club is -- pearl clubs are easily damaged. Use a diamond club instead.

Replies are listed 'Best First'.
Re: Eek! goto?
by pfaut (Priest) on Feb 11, 2003 at 23:53 UTC
    ($a,$b,$c) = unpack("V3",pack("C12",@k[0..7],0,@k[8..10]))

    assuming $a, $b, and $c start off at 0. This gives warnings for missing arguments in the pack if @k is short.

    --- print map { my ($m)=1<<hex($_)&11?' ':''; $m.=substr('AHJPacehklnorstu',hex($_),1) } split //,'2fde0abe76c36c914586c';
Re: Eek! goto?
by demerphq (Chancellor) on Feb 12, 2003 at 01:01 UTC
    { ($len or last) and $a+= $k[0]; ($len >= 2 or last) and $a+= $k[1] <<8; ($len >= 3 or last) and $a+= $k[2] <<16; ($len >= 4 or last) and $a+= $k[3] <<24; ($len >= 5 or last) and $b+= $k[4]; ($len >= 6 or last) and $b+= $k[5] <<8; ($len >= 7 or last) and $b+= $k[6] <<16; ($len >= 8 or last) and $b+= $k[7] <<24; ($len >= 9 or last) and $c+= $k[8] <<8; ($len >= 10 or last) and $c+= $k[9] <<16; ($len >= 11 or last) and $c+= $k[10] <<24; }
    No goto. :-) (er, untested, might need more parens...)

    update gah! what am I on. Reversed the test from <= to >=. Doh.

    update 2 belg4mit pointed out that it needed a semicolon added, Thanks dude,

    --- demerphq
    my friends call me, usually because I'm late....

      Updated: now I got pfaut's code to go.

      Neat! And faster (just) than the goto.

      However, with some adaption, pfaut's insight at Re: Eek! goto? allow's me to double the speed for this bit and save cycles earlier by avoiding spliting or unpacking the string to emulate the char[].

      Rate demerphq gotoit pfaut demerphq 916/s -- -1% -49% gotoit 923/s 1% -- -49% pfaut 1809/s 98% 96% --

      Benchmark and full results

      </code>

      Examine what is said, not who speaks.

      The 7th Rule of perl club is -- pearl clubs are easily damaged. Use a diamond club instead.

        I thought up another approach last night after I had logged out. It still isn't faster than pfauts, but it is an interesting example of using code templates.
        Benchmark: running demerphq, gotoit, pfaut, template, each for at least 10 CPU seconds... demerphq: 11 wallclock secs (10.52 usr) @ 4809.81/s (n=50580) gotoit: 10 wallclock secs (10.31 usr) @ 5002.33/s (n=51584) pfaut: 10 wallclock secs (10.52 usr) @ 9265.21/s (n=97433) template: 11 wallclock secs (10.56 usr) @ 5934.77/s (n=62689) Rate demerphq gotoit template pfaut demerphq 4810/s -- -4% -19% -48% gotoit 5002/s 4% -- -16% -46% template 5935/s 23% 19% -- -36% pfaut 9265/s 93% 85% 56% --
        TMTOWTDI

        ;-)

        --- demerphq
        my friends call me, usually because I'm late....

Re: Eek! goto?
by Abigail-II (Bishop) on Feb 12, 2003 at 10:45 UTC
    Well, if you think that loop is scary, have you ever seen Duff's device? http://www.lysator.liu.se/c/duffs-device.html.

    And of course, something like that can be ported to Perl:

    #!/usr/bin/perl use strict; use warnings; my $n = shift; my $m = int (($n + 7) / 8); goto L . ($n & 7); L0: do { print "zero\n"; L1: print "one\n"; L2: print "two\n"; L3: print "three\n"; L4: print "four\n"; L5: print "five\n"; L6: print "six\n"; L7: print "seven\n"; } while -- $m > 0;

    I'd love to be able to put something like that in a piece of production code.

    Abigail

      Wondribble!!


      Examine what is said, not who speaks.

      The 7th Rule of perl club is -- pearl clubs are easily damaged. Use a diamond club instead.

      The cool thing about Duff's Device is that it's surprising that a C compiler would actually accept it. In Perl, bizzare constructs are the norm, so I'm afraid the Perl version just isn't as cool (:

      ----
      Invent a rounder wheel.

Re: Eek! goto?
by Abigail-II (Bishop) on Feb 12, 2003 at 00:53 UTC
    I would do the same. It's the clearest I could come up with. To bad you won't get the same potential performance as the C switch gives you, the goto's basically has to do a linear search for the label to jump to.

    Abigail

Re: Eek! goto?
by belg4mit (Prior) on Feb 12, 2003 at 02:34 UTC
    Untested but how about
    $a += $k[$len -1] << (8* (($len>8?$len:$len-1)%4));

    --
    I'm not belgian but I play one on TV.

      Neat peice of golf:)

      Trouble is, although I probably misled you by the return ($a+$b+$c); in the benchmark code. I need the three values ($a, $b, $c) seperately in the real code.

      Adding them together to return them was just a lazy way of making sure that the different methods gave the same results. I should have returned a list.


      Examine what is said, not who speaks.

      The 7th Rule of perl club is -- pearl clubs are easily damaged. Use a diamond club instead.

        Actually no, it was me just not paying attention. You could always do
        $H{('a'x4,'b'x4,'c'x3)[$len]} += $k[$len -1] << (8* (($len>8?$len:$len +-1)%4)); #OR no code change++ but symbolic-- ${('a'x4,'b'x4,'c'x3)[$len]} += $k[$len -1] << (8* (($len>8?$len:$len- +1)%4));

        --
        I'm not belgian but I play one on TV.

Re: Eek! goto?
by RMGir (Prior) on Feb 12, 2003 at 12:55 UTC
    What if $len is out of bounds?

    The C case would work fine. Well, at least, it wouldn't crash. There's no default: label, so nothing would be done.

    Your perl program would crash with a "Can't find label ..." error in that case.
    --
    Mike

      It's a good point given the example code. In the actual application, the case cannot arise as lengths of 12 or greater are reduced to <12 by a preceding loop that process the input 12-bytes at a time. Zero length strings are rejected on entry and length can't return negatives.

      This peice of code is designed to deal with the "left-overs" (length%12).


      Examine what is said, not who speaks.

      The 7th Rule of perl club is -- pearl clubs are easily damaged. Use a diamond club instead.

        Oh, so it does look like you need Duff's device.... ;-)

        Abigail

Re: Eek! goto?
by Cabrion (Friar) on Feb 11, 2003 at 23:54 UTC
    There is a module that emultates switch on CPAN. However, the equivalent would be something like:
    if ($len == 11) { $c+= $k[10]<<24; }elseif ($len == 10) { $c+= $k[9]<<16; } elseif ...

      This isn't the same thing as the base node. There were no breaks inside the switch so it would keep falling through from the matched value to the bottom. Yours would be right if there were a break after each statement.

      --- print map { my ($m)=1<<hex($_)&11?' ':''; $m.=substr('AHJPacehklnorstu',hex($_),1) } split //,'2fde0abe76c36c914586c';
        Point taken. I guess there is a reason I stick with Perl: my C always did suck.

        Which is exactly why the original goto suggestion is about the only one that works and is concise enough to read. I don't see any other obvious ones. I'd often hash something like this but that wouldn't allow for easy emulation of the fall throughs in the C code.

Re: Eek! goto?
by forrestc (Initiate) on Feb 13, 2003 at 08:45 UTC
    I believe in clean straightforward code:
    $c=+$k[10]<<24 if ($len>=11); $c=+$k[9] <<16 if ($len>=10); $c=+$k[8] <<8 if ($len>=9); $b=+$k[7] <<24 if ($len>=8); $b=+$k[6] <<16 if ($len>=7); $b=+$k[5] <<8 if ($len>=6); $b=+$k[4] if ($len>=5); $a=+$k[3] <<24 if ($len>=4); $a=+$k[2] <<16 if ($len>=3); $a=+$k[1] <<8 if ($len>=2); $a=+$k[0] if ($len>=1);