Проблемы с многопоточным спуртом в Perl6

Я пишу программу, которая генерирует «случайные» текстовые файлы, в которых 3 слова заменены ключами, хранящимися в $keysfilename файле. Файл ключей имеет очень простую структуру, например

ASD123ASD
QWE123QWE
XZC123ZXC

Проблема возникает, когда я использую более одного потока, например

my @threads = (^32).map({

Если происходит сбой в произвольном файле, с ошибкой

    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)

Система 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;

person Ivan Ivanov    schedule 21.02.2017    source источник


Ответы (2)


Несколько заметок.

Этот:

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

на самом деле это просто: my @keys = $keysfilename.IO.words;

а это: @keys[$len.rand.round] на самом деле просто это:@keys.pick

Я не совсем уверен, что вы делаете с массивом счетчиков, похоже, вам просто нужны файлы 0..99999.

Вы делаете блокировки внутри своей подпрограммы для каждого потока. Если вы хотите, чтобы несколько потоков не обращались к чему-либо, сделайте одну внешнюю блокировку и пусть каждый из них использует ее для блокировки эксклюзивного кода.

Вы также используете Thread для создания потоков, но на самом деле это довольно низкоуровневый интерфейс. Постарайтесь использовать конструкции более высокого уровня, прежде чем опускаться до этого уровня, если это возможно.

В этом случае кажется, что вы просто хотите разделить создание 100 000 файлов на несколько потоков, чтобы получить некоторый параллелизм. Есть несколько конструкций, которые делают это действительно простым, hyper и race. Поскольку вам даже не важно, в каком порядке создаются файлы, вы можете просто использовать расу, и она будет производить их как можно быстрее.

Вы можете использовать параметр «степень» для 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(' ');
});
person Curt Tilmes    schedule 21.02.2017
comment
Замок находится вне кода. Он использовал лямбду подпрограммы, чтобы создать замыкание подпрограммы, и установил для нее &getNext. Я предполагаю, что вы должны были бы сделать это в JavaScript. Современный способ Perl/Perl 6 сделать это состоит в том, чтобы объявить их как переменные state. - person Brad Gilbert; 21.02.2017
comment
Вы правы - у меня возникли проблемы с кодом. Спасибо. - person Curt Tilmes; 21.02.2017
comment
@CurtTilmes Спасибо, я понимаю каждую строчку вашей программы))) - person Ivan Ivanov; 22.02.2017

Практически никогда нет причин использовать потоки непосредственно в Perl 6, существует множество функций, которые позволяют тяжелая работа для вас. В большинстве случаев самое простое улучшение — просто использовать 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++;
        }
    }
}

за исключением того, что вы используете только @filename для обхода семантики параметров только для чтения по умолчанию.

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

    $lock.protect: ->{
        if $counter < 100_000 {
            $filename = $counter++;
        }
    }
}

за исключением того, что было бы разумнее просто вернуть значение.

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
}

Это либо возвращает счетчик, либо Nil, которое является неопределенным значением, поэтому вы можете использовать его следующим образом:

loop {
    my $counter = get-next() orelse last;
    …
}

Поскольку вы используете подпрограмму только в цикле, она может просто вызвать last.
Или еще лучше, если вместо этого вы измените строку, в которой объявляется счетчик, на

state Int $counter = 0 but True;

Затем вы можете изменить loop на цикл while без необходимости добавлять где-либо last.

while get-next() -> $counter { … }

Теперь, когда я показал вам, как вы можете улучшить getNext, я собираюсь выбросить его и использовать гораздо более удобные функции Perl 6.
(Было бы более разумно использовать Канал кстати)

# 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(' ');
}

(Я провел тест, и он никогда не давал идентификатор потока выше 6)


Я использовал race вместо hyper, потому что возвращаемые значения все равно отбрасываются.

Если это не сработало, у вас глючная версия Rakudo. Если это так, я бы порекомендовал обновиться до последней версии v2017.02
(say $*PERL.compiler.version;)


+@array совпадает с @array.elems

^ NUMBER совпадает с 0 ..^ NUMBER, который является сахаром для

Range.new( 0, NUMBER, :excludes-max )

Это по-прежнему имеет проблему, заключающуюся в том, что некоторые «слова» содержат лишние символы.
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;
}
person Brad Gilbert    schedule 21.02.2017
comment
Отличный ответ. Ниже приведены гниды для размышления Брэда и/или примечания для других читателей. Брэд полагался на неявную переменную it ($_) во внутреннем for (for @pos...). Он мог бы сделать то же самое с внешним for (for race ...), отбросив бит -> $counter. Он мог бы написать say "$*THREAD got $_";, чтобы упростить строку say (при условии, что он отбросил $counter). Он мог бы написать @keys.pick(1), а не @keys.roll. Я бы написал подпрограмму, выполняющую строку spurt, чтобы упаковать ее уродство и специфику ОС ($*SPEC указывает код ввода-вывода, специфичный для ОС/платформы). - person raiph; 22.02.2017
comment
Убираете ли вы неявный $_? из некоторых подписей блоков (написав -> {, а не просто {) по соображениям производительности? - person raiph; 22.02.2017
comment
@raiph Я специально использовал .roll(), а не .pick(), чтобы кто-то, читающий это, быстро понял, что одно и то же значение может быть использовано более одного раза. (Я встретил одного человека, который не понимал, что каждый раз, когда вы вызываете .pick, он начинается с нуля) -> { не нужен, и он был добавлен, чтобы новые программисты Perl 6 могли понять, что это способ не указывать параметры. Все остальное должно было имитировать код в вопросе, чтобы можно было увидеть, как отсюда добраться. - person Brad Gilbert; 22.02.2017
comment
@BradGilbert Я написал getNext не потому, что знаю только JavaScript. Я использую потоки C. Программа не работает, но вылетает именно на 90_000+ файле, а не на 100+ как раньше, так что я согласен, что у меня глючная версия, т.к. на win7 та же программа выдает другое исключение (передаются 2 аргумента вместо одного). И... Я ни слова не понимаю в вашей программе, она для меня слишком лаконична и perl6-мудра. Проблема в том, что я не могу найти логические проблемы в своей программе (хотя я использую плохие, медленные и уродливые конструкции) - person Ivan Ivanov; 22.02.2017
comment
@IvanIvanov Windows, вероятно, имеет верхний предел количества файловых дескрипторов в каталоге. Вы можете обойти это, объединив их в подкаталоги. У программистов на C, кажется, больше всего проблем с Perl 6 из-за его очень высокоуровневого и функционального характера. Я думаю, что упаковал месяц или больше обучения в один пост. То, как вы соединяете конструкции, выглядит странно, и за этим сложно уследить тому, кто знаком с языком. Это не значит, что он плохой, медленный или уродливый. Мы ласково называем такой код «детским Perl 6». (никакого неуважения) - person Brad Gilbert; 22.02.2017
comment
@BradGilbert Я сменил компьютер на x64, и теперь он работает, как твоя, так и моя программа. Но когда я использую большое количество потоков (в моей явной реализации потоков), он зависает на компьютере. - person Ivan Ivanov; 23.02.2017