Perl6多线程突发问题

Iva*_*nov 3 multithreading perl6

我编写生成"随机"文本文件的程序,其中3个单词替换为存储在$keysfilename文件中的键.Keys文件结构非常简单,就像

ASD123ASD
QWE123QWE
XZC123ZXC
Run Code Online (Sandbox Code Playgroud)

例如,当我使用多个线程时会出现问题

my @threads = (^32).map({
Run Code Online (Sandbox Code Playgroud)

如果在任意文件上失败,则会出错

    started
Thread<17>(14) got 1
Thread<18>(15) got 2
Thread<20>(17) got 17
Thread<5>(2) got 3
Thread<16>(13) got 4
Thread<21>(18) got 5
Thread<3>(0) got 6
Thread<8>(5) got 7
Thread<12>(9) got 10
Thread<11>(8) got 8
Thread<9>(6) got 9
Thread<14>(11) got 11
Thread<15>(12) got 12
Unhandled exception: Failed to open file C:\c\perltests\00000017.txt: no such file or directory
Thread<10>(7) got 13
Thread<13>(10) got 14
Thread<7>(4) got 15
Thread<19>(16) got 16
Thread<4>(1) got 0
Thread<6>(3) got 18
Thread<22>(19) got 19
   at <unknown>:1  (C:\rakudo/share/perl6/runtime/CORE.setting.moarvm:throw:4294967295)
Thread<23>(20) got 20
Thread<24>(21) got 21
 from gen/moar/m-CORE.setting:22337  (C:\rakudo/share/perl6/runtime/CORE.setting.moarvm:throw:34)
Thread<26>(23) got 22
Thread<25>(22) got 23
Thread<27>(24) got 24
 from gen/moar/m-CORE.setting:22374  (C:\rakudo/share/perl6/runtime/CORE.setting.moarvm:FALLBACK:35)
Thread<28>(25) got 25
Thread<29>(26) got 26
 from gen/moar/m-Metamodel.nqp:3041  (C:\rakudo\share\nqp\lib/Perl6/Metamodel.moarvm::13)
Thread<30>(27) got 27
Thread<16>(13) got 28
Thread<17>(14) got 29
Thread<5>(2) got 30
Thread<18>(15) got 31
Thread<14>(11) got 32
Thread<15>(12) got 33
 from gen/moar/m-CORE.setting:25189  (C:\rakudo/share/perl6/runtime/CORE.setting.moarvm:spurt:226)
Thread<30>(27) got 58
Thread<29>(26) got 57
Unhandled exception: Failed to open file C:\c\perltests\00000028.txt: no such file or directory
Thread<28>(25) got 56
 from gen/moar/m-CORE.setting:25203  (C:\rakudo/share/perl6/runtime/CORE.setting.moarvm:spurt:92)
Thread<25>(22) got 55
 from gen/moar/m-CORE.setting:25199  (C:\rakudo/share/perl6/runtime/CORE.setting.moarvm:spurt:44)
Thread<27>(24) got 54
 from gen/moar/m-CORE.setting:25506  (C:\rakudo/share/perl6/runtime/CORE.setting.moarvm:spurt:96)
Thread<26>(23) got 53
 from gentexts.pl:54  (<ephemeral file>::189)
Thread<24>(21) got 52
Thread<23>(20) got 51
Unhandled exception: Failed to open file C:\c\perltests\00000058.txt: no such file or directory
Thread<6>(3) got 50
Thread<22>(19) got 49
   at <unknown>:1  (C:\rakudo/share/perl6/runtime/CORE.setting.moarvm:throw:4294967295)
Thread<34>(31) got 48
 from gen/moar/m-CORE.setting:22337  (C:\rakudo/share/perl6/runtime/CORE.setting.moarvm:throw:34)
Thread<33>(30) got 47
Thread<4>(1) got 46
 from gen/moar/m-CORE.setting:22374  (C:\rakudo/share/perl6/runtime/CORE.setting.moarvm:FALLBACK:35)
Thread<7>(4) got 45
 from gen/moar/m-Metamodel.nqp:3041  (C:\rakudo\share\nqp\lib/Perl6/Metamodel.moarvm::13)
Thread<19>(16) got 44
Thread<11>(8) got 43
   at <unknown>:1  (C:\rakudo/share/perl6/runtime/CORE.setting.moarvm:throw:4294967295)
Thread<8>(5) got 42
 from gen/moar/m-CORE.setting:22337  (C:\rakudo/share/perl6/runtime/CORE.setting.moarvm:throw:34)
Thread<12>(9) got 41
Thread<10>(7) got 40
 from gen/moar/m-CORE.setting:25189  (C:\rakudo/share/perl6/runtime/CORE.setting.moarvm:spurt:226)
Thread<13>(10) got 39
 from gen/moar/m-CORE.setting:25203  (C:\rakudo/share/perl6/runtime/CORE.setting.moarvm:spurt:92)
Thread<31>(28) got 37
 from gen/moar/m-CORE.setting:25199  (C:\rakudo/share/perl6/runtime/CORE.setting.moarvm:spurt:44)
Thread<32>(29) got 38
Thread<9>(6) got 36
 from gentexts.pl:44  (<ephemeral file>::15)
Thread<3>(0) got 35
Thread<21>(18) got 34
 from gen/moar/m-CORE.setting:22374  (C:\rakudo/share/perl6/runtime/CORE.setting.moarvm:FALLBACK:35)
Thread<17>(14) got 59
 from gen/moar/m-CORE.setting:25506  (C:\rakudo/share/perl6/runtime/CORE.setting.moarvm:spurt:96)
Thread<5>(2) got 60
Thread<18>(15) got 61
 from gentexts.pl:54  (<ephemeral file>::189)
Thread<9>(6) got 85
Thread<32>(29) got 84
 from gen/moar/m-CORE.setting:30638  (C:\rakudo/share/perl6/runtime/CORE.setting.moarvm:THREAD-ENTRY:44)
Run Code Online (Sandbox Code Playgroud)

System Win 10 x32,Rakudo 6.c

my $keysfilename := 'C:/c/keysfile.txt';
my $output       := 'C:/c/perltests';

my @keys = ();
for $keysfilename.IO.words {
    @keys.push($_);
}
my $len  := elems @keys;

my $lorem = q:to/END/; 
Lorem ipsum dolor sit amet, consectetur adipiscing elit. Donec malesuada purus vel tincidunt eleifend. Fusce sollicitudin augue augue, et gravida dolor varius a. Vestibulum iaculis, dui iaculis iaculis molestie, tellus ante hendrerit massa, at volutpat risus metus vitae nisi. Integer neque magna, ultrices eu erat at, efficitur sollicitudin sem. Aliquam sed purus malesuada, porta est eu, rutrum neque. Quisque dolor leo, condimentum non mollis eget, tristique eget odio. Donec dignissim magna nec imperdiet iaculis. Vestibulum lorem ligula, euismod ac porttitor faucibus, rutrum eu ex.

Donec scelerisque nisi eget risus condimentum ultrices. Integer porta maximus quam, in lobortis quam fermentum eu. Morbi eu ligula consequat, aliquam sem eget, sollicitudin eros. Suspendisse potenti. Cras finibus metus et eros accumsan, id vehicula libero lobortis. Aenean vulputate lacinia urna at fringilla. Nulla id tincidunt lectus, quis accumsan lorem. In posuere magna non purus hendrerit rutrum. Maecenas in mattis tellus. Maecenas vel feugiat enim. Lorem ipsum dolor sit amet, consectetur adipiscing elit. Proin convallis dapibus tellus vitae euismod. Nam eleifend dui quam, eget lobortis quam pulvinar id. Cras euismod posuere dolor non ultricies.

Ut dapibus porta faucibus. Duis velit ante, tincidunt id velit id, imperdiet egestas velit. Morbi efficitur enim dignissim interdum egestas. Vivamus eu urna condimentum, aliquam orci non, ullamcorper est. Phasellus egestas at tellus nec tristique. Fusce feugiat commodo faucibus. In hac habitasse platea dictumst. Quisque dignissim, mauris a pellentesque dictum, mauris velit tincidunt lorem, sed tincidunt libero enim vitae orci. Nam interdum, ante nec consequat vulputate, nisi turpis euismod nibh, sit amet elementum nunc diam non eros. Proin quis viverra risus. Vestibulum vestibulum diam in velit consectetur, eu elementum lacus sagittis. Morbi accumsan ac ante eget faucibus. In nec elit bibendum, tristique enim non, sodales ex. Donec sodales erat vitae odio cursus commodo.

Vestibulum felis lacus, mattis eget porta eget, mattis ut felis. Pellentesque aliquet, purus eu semper suscipit, sem ipsum euismod nunc, sed dapibus augue sem vel elit. Etiam tincidunt arcu ut nisi tempor commodo. Mauris at eros tincidunt, fringilla erat nec, sagittis ante. Integer et malesuada quam. Cras vel porta erat, sit amet efficitur erat. Praesent blandit purus quis urna consectetur, eget ultricies ipsum pulvinar. Phasellus ac molestie elit. Vestibulum et tincidunt velit. Aliquam a venenatis ipsum, nec commodo libero. Nullam eget consectetur lectus. Morbi placerat interdum erat nec interdum.

Morbi bibendum dui eu turpis pretium, eget aliquet augue aliquam. Aliquam eu dignissim mauris, vitae placerat augue. Ut sed tortor sit amet augue imperdiet rutrum. Aliquam erat volutpat. Morbi a turpis in sapien ultrices tristique. Proin quis vestibulum lorem, ut pharetra ex. Quisque tempor bibendum purus ac vehicula. Suspendisse tellus ipsum, imperdiet id sodales vel, congue a leo. Nulla gravida tincidunt nisi eu tempor. Mauris imperdiet tempor ante eget rutrum. Nam ut dui at augue laoreet mollis. Sed metus elit, viverra ac fringilla vel, fermentum et magna. Nam ligula purus, pretium vel dignissim vitae, fermentum at urna. Nullam ac ullamcorper felis. Maecenas dapibus consequat mi. 
END

my @words = $lorem.split(' ');
my $wordlen = @words.elems;

my &getNext = sub {
    my $counter = 0;
    my Lock $lock .= new;
    return sub (@filename) {
        $lock.lock;
        if ($counter < 100_000) {
            @filename[0] = $counter;
            $counter++;
        }
        $lock.unlock;
    };
}();

say "started";

my @threads = (^1).map({
    Thread.start(
        name => $_,
        sub {
            loop {              
                my @counter = (-1);
                getNext(@counter);
                last if @counter[0] < 0;
                say $*THREAD ~ " got " ~ @counter[0];
                my @copy = @words.clone;
                for (^3) {
                    my $pos = $wordlen.rand.round;
                    @copy[$pos] = @keys[$len.rand.round];
                }
                spurt sprintf($output ~ '/%08d.txt', @counter[0]), @copy.join(' ');
            }
        }
    );
}).join;
Run Code Online (Sandbox Code Playgroud)

Cur*_*mes 9

几点说明.

这个:

my @keys = ();
for $keysfilename.IO.words {
    @keys.push($_);
}
Run Code Online (Sandbox Code Playgroud)

真的就是这样: my @keys = $keysfilename.IO.words;

而这:@keys[$len.rand.round] 真的就是这样:@keys.pick

我不太清楚你在使用计数器阵列做什么,看起来你只是想要文件0..99999.

您正在为每个线程在子例程中创建锁.如果要保持多个线程不访问某些内容,请在外部进行一次锁定,并让每个线程使用它来锁定独占代码.

你也Thread用来制作线程,但这确实是一个非常低级别的界面.如果可能的话,尝试使用更高级别的构造,然后再降级到该级别.

在这种情况下,您似乎只想将100,000个文件创建分成多个线程,以获得一些并行性.有一些结构使得它非常简单,hyper并且 race.因为你甚至不关心创建文件的顺序,所以你可以使用race,它会尽快将它们转出来.

您可以使用'degree'参数来race说明要使用的线程数.(您可能需要设置RAKUDO_MAX_THREADS以获得所需的行为).

my $keysfilename := 'C:/c/keysfile.txt';
my $output       := 'C:/c/perltests';

my @keys = $keysfilename.IO.words;

my $lorem = q:to/END/; 
Lorem ipsum ...
END

my @words = $lorem.split(' ');
my $wordlen = @words.elems;

[^100000].race(degree => 32).map({ 
#    say $*THREAD ~ " got " ~ $_;

    my @copy = @words;

    for (^3) {
        my $pos = $wordlen.rand.round;
        @copy[$pos] = @keys.pick;
    }

    spurt sprintf($output ~ '/%08d.txt', $_), @copy.join(' ');
});
Run Code Online (Sandbox Code Playgroud)


Bra*_*ert 8

在Perl 6中几乎没有理由直接使用Threads,有很多功能可以为你付出艰苦的努力.在大多数情况下,最简单的改进是只使用start来代替Thread.start,而await LIST不是LIST».join或LIST.map(*.join).

你打电话了List.join没有Thread.join,这可能是至少部分为什么你有问题.

还有很多东西使这难以阅读和理解.


通过你如何写getNext它似乎你只知道或大多只知道JavaScript.这就是我写它的方式.

sub get-next (@filename) {
    state Int $counter = 0;  # set to zero only the first time it is called
    state Lock $lock .= new;

    $lock.protect: ->{
        if $counter < 100_000 {
            @filename[0] = $counter++;
        }
    }
}
Run Code Online (Sandbox Code Playgroud)

除了你只是@filename用来绕过参数的默认只读语义.

sub get-next ($filename is rw) {
    state Int $counter = 0;
    state Lock $lock .= new;

    $lock.protect: ->{
        if $counter < 100_000 {
            $filename = $counter++;
        }
    }
}
Run Code Online (Sandbox Code Playgroud)

除了返回值更有意义.

sub get-next () {
    state Int $counter = 0;
    state Lock $lock .= new;

    $lock.protect: ->{
        $counter++ if $counter < 100_000
    } // Nil
    # the `if` will return `Empty` when $counter gets too big
    # but we want `Nil` instead
}
Run Code Online (Sandbox Code Playgroud)

这将返回计数器或Nil未定义的值,因此您可以像这样使用它:

loop {
    my $counter = get-next() orelse last;
    …
}
Run Code Online (Sandbox Code Playgroud)

由于您只在循环中使用sub,因此它可以last自行调用.
或者更好的是,如果您改为声明计数器的行

state Int $counter = 0 but True;
Run Code Online (Sandbox Code Playgroud)

然后你可以改成loop一个while循环,不需要在last任何地方添加.

while get-next() -> $counter { … }
Run Code Online (Sandbox Code Playgroud)

现在我向您展示了如何改进getNext,我将把它扔掉并使用Perl 6的更好的功能.
(顺便使用Channel会更有意义)

# will probably still work with `use v6.c;`
# but v6.d has a better system backing `await`
use v6.d.PREVIEW;

# override the original default number of threads
# (16 threads currently)
BEGIN %*ENV<RAKUDO_MAX_THREADS> //= 32;
# the "correct" way to do this is setting $*SCHEDULER
# but this is easier

my $keys-filename = 'C:/c/keysfile.txt';
my $output-dir    = 'C:/c/perltests';

my @keys = $keys-filename.IO.words;

my @lorem = q:to/EOF/.split(' ');
…
EOF

say 'started';
END say 'finished';

for race ^100_000 -> $counter {
    say $*THREAD, " got ", $counter;
    my @copy = @lorem; # no need for .clone

    for (^+@copy).pick(3) -> $pos {
        @copy[$pos] = @keys.roll;
    }

    spurt $*SPEC.catfile($output-dir, $counter.fmt('/%08d.txt')), @copy.join(' ');
}
Run Code Online (Sandbox Code Playgroud)

(我运行了一个测试,它的线程ID从未超过6)


我使用race而不是hyper因为返回值无论如何都被扔掉了.

如果它不起作用,你有一个错误版本的Rakudo.如果是这样,我建议更新到最新版本v2017.02
(say $*PERL.compiler.version;)


+@array 是相同的 @array.elems

^ NUMBER和0 ..^ NUMBER糖一样

Range.new( 0, NUMBER, :excludes-max )
Run Code Online (Sandbox Code Playgroud)

这仍然存在一些"单词"具有额外字符的问题.
amet, elit.而ex.??Donec例如

…

my @pos = ($lorem ~~ m:ex/ « \w+: /).map: { .from, .chars }
# @pos looks something like [(0,5),(6,5),(12,5),(18,3),…]

…

for race ^100_000 -> $counter {
    say $*THREAD, " got ", $counter;

    # vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
    my $copy = $lorem;

    # sort so that the transforms are done from the end of the string
    # towards the beginning of the string
    for @pos.pick(3).sort.reverse {
      $copy.substr-rw( |$_ ) = @keys.roll;
    }
    # ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

    spurt $*SPEC.catfile($output-dir, $counter.fmt('/%08d.txt')), $copy;
}
Run Code Online (Sandbox Code Playgroud)