concurrency - 当线程太少时，程序挂起

Question

当为 -t=17 -fn=15 运行以下程序时，然后程序在合理的时间内停止。这意味着最大线程数大于写入和并发缓存的文件数。

按要求更新:profiler output当 $ perl6 --profile con-test.p6 -t=7 -fn=5

当 -t >= -fn 时，程序无法停止!

当程序为 -t=17 -fn=20 --hack 运行时然后程序在合理的时间内运行完成。

我不知道下面的程序是否因为我在 CompUnit 中遇到问题而失败，或者是否存在我遗漏的线程(或其他)问题。

假设存在某种线程情况并且文件数必须小于线程数，那么重写 hack 的最佳方法是什么。目前，一个数组被 Promise 填充，然后允许保留。但是 await 要求在清空数组并重新填充它之前保留所有这些。我认为应该以某种方式将其重写为 channel 或供应。但是，我无法完全弄清楚如何做到这一点。

提前致谢。

use v6.c;
use nqp;
use File::Directory::Tree;

my Lock $lock;
my $precomp;
#assume a writable directory files/

sub MAIN(:$t=5, :$fn = 10, :$hack=False ) {
    PROCESS::<$SCHEDULER> = ThreadPoolScheduler.new(initial_threads => 0, max_threads => $t);

    rmtree '.test';
    empty-directory 'files';

    my $precomp-store = CompUnit::PrecompilationStore::File.new(prefix => '.test'.IO );
    $precomp = CompUnit::PrecompilationRepository::Default.new(store => $precomp-store);
    $lock .=new;
    my %files = |gather for ^$fn {
        my $f = "files/name_$_.pod6";
        $f.IO.spurt: data;
        take "name_$_" => %(:key(nqp::sha1($f)), :path($f))
    }
    my @compilations;
    my @compiled;
    for %files.kv -> $source, (:path($path), :key($key)) {
        @compilations.push: start compile( $source, $key, $path );
        if $hack {
           if @compilations.elems %% ($t - 2) {
              @compiled.append: await @compilations;
              @compilations = ()
          }
       }
    }
    @compiled.append: await @compilations;
    for @compiled {
        if .<error>.defined {
            say .<error>
        }
        else {
            say .<source> ~ ' compiled'
        }
    }
}

sub compile( $source, $key, $path ) {
    my ($handle , $error, $status );
    try {
        CATCH {
            default {
                $error = "Compile error in $source:\n\t" ~ .Str
            }
        }
        $lock.protect( {
            $precomp.precompile($path.IO, $key, :force );
            $handle = $precomp.load($key)[0];
        })
    }
    with $handle {
        $status = 'OK';
    }
    else {
        $status = 'Failed';
        $error = 'unknown precomp error' without $error; # make sure that $error is defined for no handle
    }
    %(:$error, :$status, :$source)
}

sub data(-->Str ) {
    q:to/DD/
    =begin pod :tag<self>

    =TITLE Community
    X<|Community>

    =SUBTITLE Information about the people working on and using Perl 6

    =head1 Overview

    "Perl 5 was my rewrite of Perl.  I want Perl 6 to be the community's rewrite
    of Perl and of the community." - Larry Wall

    =head1 The Perl 6 community

    There is a large presence on the C<#perl6> channel on C<freenode.net>,
    who are happy to provide support and answer questions. More resources can be found in the L<perl6.org community page|https://perl6.org/community/>. L<Camelia|https://perl6.org/>, the multi-color butterfly with P 6 in her wings, is the symbol of this diverse and welcoming community. We use extensively
    the L<C<#perl6>|https://perl6.org/community/irc> IRC channel for communication, questions and simply hanging out. Check out this L<IRC lingo|http://www.ircbeginner.com/ircinfo/abbreviations.html> resource for the abbreviations frequently used there.  L<StackOverflow|https://stackoverflow.com/questions/tagged/perl6> is also a great resource for asking questions and helping others with their Perl 6 problems and challenges.

    The Perl 6 community publishes every December an L<Advent Calendar|https://perl6advent.wordpress.com/>, with Perl 6 tutorials every day until Christmas. Organization and assignment of days is done through the different Perl 6 channels and the L<Perl6/mu|https://github.com/perl6/mu> repository. If you want to participate, it starts organization by the end of October, so check out the channels above for that.

    =end pod

    DD
}

Answer 1

问题是如果需要的线程太多，那么程序就会挂掉，所以一个解决方法是创建一个队列，分配尽可能多的线程，然后当每个线程中的例程完成时，它将数据从队列中弹出。

下面我实现了这个策略，它处理线程数小于文件数的情况，不会卡顿。实际上，线程数必须比文件数少两个(参见 if +@threads < $t - 2 )。将 2 减少到 1 会导致程序再次挂起。不完全确定这是为什么。

以下是用队列重写问题中的程序。

#!/usr/bin/env perl6
use v6.d;
use nqp;
use File::Directory::Tree;

my Lock $lock;
my $precomp;
#assume a writable directory files/

sub MAIN(:$t=15, :$fn = 10 ) {
    say "Threads: $t, Files: $fn, Compiler:", $*PERL;
    PROCESS::<$SCHEDULER> = ThreadPoolScheduler.new(initial_threads => 0, max_threads => $t);

    rmtree '.test';
    empty-directory 'files';

    my $precomp-store = CompUnit::PrecompilationStore::File.new(prefix => '.test'.IO );
    $precomp = CompUnit::PrecompilationRepository::Default.new(store => $precomp-store);
    $lock .=new;
    my %files = |gather for ^$fn {
        my $f = "files/name_$_.pod6";
        $f.IO.spurt: data;
        take "name_$_" => %(:key(nqp::sha1($f)), :path($f))
    }
    my @compilations;
    my @compiled;
    my @threads; 
    for %files.kv -> $source, (:path($path), :key($key)) {
        @compilations.push: ( $source, $key, $path );
        @threads.push( start
            sub ( @queue ) {
                my @params = @queue.pop.list if @queue;
                return unless +@params;
                my $res = compile( |@params );
                $lock.protect({
                    @compiled.append: $res;
                });
                &?ROUTINE( @queue )
            }( @compilations )
        )  if +@threads < $t - 2;
    }
    await @threads;
    for @compiled {
        if .<error>.defined {
            say .<error>
        }
        else {
            say .<source> ~ ' compiled'
        }
    }
}

sub compile( $source, $key, $path ) {
    my ($handle , $error, $status );
    try {
        CATCH {
            default {
                $error = "Compile error in $source:\n\t" ~ .Str
            }
        }
        $precomp.precompile($path.IO, $key, :force );
        $handle = $precomp.load($key)[0];
    }
    with $handle {
        $status = 'OK';
    }
    else {
        $status = 'Failed';
        $error = 'unknown precomp error' without $error; # make sure that $error is defined for no handle
    }
    %(:$error, :$status, :$source)
}

sub data(-->Str ) {
    q:to/DD/
    =begin pod :tag<self>

    =TITLE Community
    X<|Community>

    =SUBTITLE Information about the people working on and using Perl 6

    =head1 Overview

    "Perl 5 was my rewrite of Perl.  I want Perl 6 to be the community's rewrite
    of Perl and of the community." - Larry Wall

    =head1 The Perl 6 community

    There is a large presence on the C<#perl6> channel on C<freenode.net>,
    who are happy to provide support and answer questions. More resources can be found in the L<perl6.org community page|https://perl6.org/community/>. L<Camelia|https://perl6.org/>, the multi-color butterfly with P 6 in her wings, is the symbol of this diverse and welcoming community. We use extensively
    the L<C<#perl6>|https://perl6.org/community/irc> IRC channel for communication, questions and simply hanging out. Check out this L<IRC lingo|http://www.ircbeginner.com/ircinfo/abbreviations.html> resource for the abbreviations frequently used there.  L<StackOverflow|https://stackoverflow.com/questions/tagged/perl6> is also a great resource for asking questions and helping others with their Perl 6 problems and challenges.

    The Perl 6 community publishes every December an L<Advent Calendar|https://perl6advent.wordpress.com/>, with Perl 6 tutorials every day until Christmas. Organization and assignment of days is done through the different Perl 6 channels and the L<Perl6/mu|https://github.com/perl6/mu> repository. If you want to participate, it starts organization by the end of October, so check out the channels above for that.

    =end pod

    DD
}