Re: pop() on a fast multi-core cpu

[Anonymous Monk]

#!/usr/bin/perl

use warnings; use strict; use Time::HiRes qw(gettimeofday tv_interval)
+; 

my( @suit, @deck); my @ups = qw( 0 0 0 0 0 0 0 0 0 0); my $cntr = 0; 

Deck();    # four shuffled suits are added to a deck and then shuffled

print "\n"; my $t0 = gettimeofday;

T0:    $ups[0] = Card(); $ups[1] = Card(); # draw cards for pos #0 & #
+1
T1:    if($ups[0] eq $ups[1]) { goto T0; }    # cover a pair & go back

    if($ups[2] eq '0') { $ups[2] = Card(); } # fill pos#2 if vacant

    # check pos#2 against pos#0 - cover a pair & go back
    if($ups[2] eq $ups[0]) { Cover(2,0); goto T1; }
    # check pos#2 against pos#1 - cover a pair & go back
      if($ups[2] eq $ups[1]) { Cover(2,1); goto T1; }

    # watch the rows for pairs that don't get covered
    foreach my $x (@ups) { print "$x "; } print "\n"; 

    for(my $j=3;$j<10;$j++) {
        if($ups[$j] eq '0') { $ups[$j] = Card(); }
        for(my $k=0;$k<$j;$k++) {
            if($ups[$j] eq $ups[$k]) { Cover($j,$k); goto T1; } } }   
+  

TX:    print "\n";
    foreach my $x (@ups) { print "$x "; } print "\t\tExit row\n"; 
    
    my $del_t = (gettimeofday - $t0) * 10**6;
    my $usec = sprintf("%.2f",$del_t);  
    print "\n$cntr passes in $usec microseconds. ";
    if($cntr == @deck) { print "Success!\n\n"; }
    else { print "{sigh...}\n\n"; }    

#========================================

sub Card {    my $tmp = $deck[$cntr]; $cntr++;
            if($tmp ne 'X') { return $tmp; } else { goto TX; } }

sub Suit {    @suit = qw(A B C D E F G H I J K L M ); 
            for(my $i=$#suit;$i>0;$i--) {
            my $j = int(rand($i + 1));
            @suit[$i, $j] = @suit[$j, $i]; } }    

sub Deck {    for(my $i=0;$i<4;$i++) { Suit(); @deck = (@deck,@suit); 
+}
            for(my $i=$#deck;$i>0;$i--) {
                my $j = int(rand($i + 1));
                @deck[$i, $j] = @deck[$j, $i];
            } push(@deck,"X"); }

sub Cover { my $x = $_[0]; my $y = $_[1];
            $ups[$x] = Card(); $ups[$y] = Card(); }

pre tags replaced by Code tags by Grandfather

[choroba]

Use <code> tags, otherwise array indices are turned into links.

#!/usr/bin/perl

use warnings; use strict; use Time::HiRes qw(gettimeofday tv_interval)
+; 


my( @suit, @deck); my @ups = qw( 0 0 0 0 0 0 0 0 0 0); my $cntr = 0; 

Deck();    # four shuffled suits are added to a deck and then shuffled

print "\n"; my $t0 = gettimeofday;

T0:    $ups[0] = Card(); $ups[1] = Card(); # draw cards for pos #0 & #
+1
T1:    if($ups[0] eq $ups[1]) { goto T0; }    # cover a pair & go back

    if($ups[2] eq '0') { $ups[2] = Card(); } # fill pos#2 if vacant

    # check pos#2 against pos#0 - cover a pair & go back
    if($ups[2] eq $ups[0]) { Cover(2,0); goto T1; }
    # check pos#2 against pos#1 - cover a pair & go back
      if($ups[2] eq $ups[1]) { Cover(2,1); goto T1; }

    # watch the rows for pairs that don't get covered
    foreach my $x (@ups) { print "$x "; } print "\n"; 

    for(my $j=3;$j<10;$j++) {
        if($ups[$j] eq '0') { $ups[$j] = Card(); }
        for(my $k=0;$k<$j;$k++) {
            if($ups[$j] eq $ups[$k]) { Cover($j,$k); goto T1; } } }   
+  

TX:    print "\n";
    foreach my $x (@ups) { print "$x "; } print "\t\tExit row\n"; 
    
    my $del_t = (gettimeofday - $t0) * 10**6;
    my $usec = sprintf("%.2f",$del_t);  
    print "\n$cntr passes in $usec microseconds. ";
    if($cntr == @deck) { print "Success!\n\n"; }
    else { print "{sigh...}\n\n"; }    

#========================================

sub Card {    my $tmp = $deck[$cntr]; $cntr++;
            if($tmp ne 'X') { return $tmp; } else { goto TX; } }

sub Suit {    @suit = qw(A B C D E F G H I J K L M ); 
            for(my $i=$#suit;$i>0;$i--) {
            my $j = int(rand($i + 1));
            @suit[$i, $j] = @suit[$j, $i]; } }    

sub Deck {    for(my $i=0;$i<4;$i++) { Suit(); @deck = (@deck,@suit); 
+}
            for(my $i=$#deck;$i>0;$i--) {
                my $j = int(rand($i + 1));
                @deck[$i, $j] = @deck[$j, $i];
            } push(@deck,"X"); }

sub Cover { my $x = $_[0]; my $y = $_[1];
            $ups[$x] = Card(); $ups[$y] = Card(); }

I tried running the script 1000 times in 5.26.1 and the current blead (5.41.5-22-ga8a74a872d). There was no warning.

[LanX]

Your code is based on 4 normal goto plus one which is called inside Card() to leave the sub, which is called 4 more times, plus 2 times inside Cover() which is called thrice.

These are 16 jumps in total.

All this is "determined" on randomized data.

Respect, you put the spaghetti into spaghetti code.

That's highly unpredictable, and the missing code indentation doesn't make it easier to grasp.

If your problems didn't or rarely happened before but are now, one reason might be differences in arithmetics.

We just had a talk at the London Perl Workshop about an undiscovered bug only showing up if the same code and Perl version was run on a newer Ubuntu version.

The precision jumped and the code crashed because a threshold was exceeded.

Nota Bene: the code was already buggy before, but this went unnoticed.