Contrived from original problem, concurrent version. You have to increase the size of the kernel queue for it to work. Command is in script comment. If you don't, should exit cleanly, but get some error spam.
#!/usr/bin/env perl
use strict;
use warnings;
use feature 'say';
use IPC::SysV qw/IPC_PRIVATE S_IRUSR S_IWUSR IPC_NOWAIT/;
use IPC::Msg;
# echo $((2**31-1)) > /proc/sys/kernel/msgmnb
my $q = IPC::Msg->new(IPC_PRIVATE,S_IRUSR|S_IWUSR);
sub quit { $q->remove; }
$SIG{INT} = \&quit;
my $string = '12345678912345';
$q->snd(1,$string) or die "$!";
$q->snd(1,"-$string") or die "$!";
my $parent = $$;
my $n_workers = shift // die;
die "128 workers max" if ($n_workers > 7);
fork // die $! for (1..$n_workers);
while ( $q->rcv(local $_,32,0,IPC_NOWAIT) ) {
say if eval == 100;
while (/\d+?/g) {
next if ( !$' || index( $', '-' ) > -1 || index( $', '+' ) > -
+1 );
$q->snd(1,"$`$&+$'",IPC_NOWAIT) or die $!;
$q->snd(1,"$`$&-$'",IPC_NOWAIT) or die $!;
}
}
END {
1 until wait == -1;
if ($$ == $parent) {
quit;
}
}
- 2x - 2m11s
- 4x - 55s
- 8x - 23s
- 16x - 12s
- 32x - 7s
