[delphi-users:4570] TTask.Createの立上りが遅い

[tonbo]

tonboです。
このメーリングリストには大変お世話になっています。

TTask.Createの立上りが遅く困っています。

環境:Windows7 32bit + Delphi XE8
Windows10 64bit + Delphi Seatle　でも同じ

FormにButton 2つ(タスク開始、タスク終了)を貼り付け、
IDE上で、表示/デバッグ/スレッドで「スレッドの状態」を
表示しながら、以下のプログラムを実行します。
4つのタスクは即立ち上がるのですが、5つ目から
1つ1秒づつかかり、10個全て立ち上がるのに6.5秒
かかる様子が見えます。

立上り時間を表示するように修正し、IDEではなくEXEを
直接実行させても同じく6.5秒かかります。
(=IDEが原因ではない)

質問1:TTask.Createの立上りはこんなに遅いものでしょうか？

質問2:立上りを早めることができますでしょうか？

質問3:できない場合、TTask.Create以外で短時間で
　　　立ち上がる使い易いThreadはありますでしょうか？

実際の運用では20個のタスクを立ち上げます。
この時は16.5秒もかかり実用に耐えません。
ご指導よろしくお願いします。


プログラム全文
//------------------------------------------------------------
unit Unit1;

interface

uses
Windows, Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,
System.Threading;

type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private 宣言 }
procedure Task0;
procedure Task1;
procedure Task2;
procedure Task3;
procedure Task4;
procedure Task5;
procedure Task6;
procedure Task7;
procedure Task8;
procedure Task9;
public
{ Public 宣言 }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

var
tasks : array of ITask;
TaskStop : Boolean;

procedure TForm1.Button1Click(Sender: TObject);
//タスク開始
begin
Setlength (tasks ,10);

TaskStop := False;

tasks[0] := TTask.Create (Task0);
tasks[0].Start;

tasks[1] := TTask.Create (Task1);
tasks[1].Start;

tasks[2] := TTask.Create (Task2);
tasks[2].Start;

tasks[3] := TTask.Create (Task3);
tasks[3].Start;

tasks[4] := TTask.Create (Task4);
tasks[4].Start;

tasks[5] := TTask.Create (Task5);
tasks[5].Start;

tasks[6] := TTask.Create (Task6);
tasks[6].Start;

tasks[7] := TTask.Create (Task7);
tasks[7].Start;

tasks[8] := TTask.Create (Task8);
tasks[8].Start;

tasks[9] := TTask.Create (Task9);
tasks[9].Start;
end;

procedure TForm1.Button2Click(Sender: TObject);
//タスク終了
begin
TaskStop := True;
end;

procedure TForm1.Task0;
begin
while True do
begin
if TaskStop = True then Exit;
sleep(1);
end;
end;

procedure TForm1.Task1;
begin
while True do
begin
if TaskStop = True then Exit;
sleep(1);
end;
end;

procedure TForm1.Task2;
begin
while True do
begin
if TaskStop = True then Exit;
sleep(1);
end;
end;

procedure TForm1.Task3;
begin
while True do
begin
if TaskStop = True then Exit;
sleep(1);
end;
end;

procedure TForm1.Task4;
begin
while True do
begin
if TaskStop = True then Exit;
sleep(1);
end;
end;

procedure TForm1.Task5;
begin
while True do
begin
if TaskStop = True then Exit;
sleep(1);
end;
end;

procedure TForm1.Task6;
begin
while True do
begin
if TaskStop = True then Exit;
sleep(1);
end;
end;

procedure TForm1.Task7;
begin
while True do
begin
if TaskStop = True then Exit;
sleep(1);
end;
end;

procedure TForm1.Task8;
begin
while True do
begin
if TaskStop = True then Exit;
sleep(1);
end;
end;

procedure TForm1.Task9;
begin
while True do
begin
if TaskStop = True then Exit;
sleep(1);
end;
end;

end.


MLホームページ: http://www.freeml.com/delphi-users

----------------------------------------------------------------------
お酒も健康も大切。そんな方から選ばれています。
しじみの栄養を毎日手軽に摂れるように、そう考えて開発されました。
しじみの良さを引き出した「しじみ習慣」。
まずは、１０日間無料でお試しください。全国送料無料。
http://ad.freeml.com/cgi-bin/sa.cgi?id=pvBas
------------------------------------------------------[freeml byGMO]--

[高木太郎]

　こんにちは、イマジオムの高木です。　久しぶりに投稿します。

　＃いまだに Delphi XE2＋ＶＣＬを主力に使っていますので、
　　新しい話題についていけていないのです……

tonbo さん：

> TTask.Createの立上りが遅く困っています。
>
> 環境:Windows7 32bit + Delphi XE8
> Windows10 64bit + Delphi Seatle　でも同じ
>
> FormにButton 2つ(タスク開始、タスク終了)を貼り付け、
> IDE上で、表示/デバッグ/スレッドで「スレッドの状態」を
> 表示しながら、以下のプログラムを実行します。
> 4つのタスクは即立ち上がるのですが、5つ目から
> 1つ1秒づつかかり、10個全て立ち上がるのに6.5秒
> かかる様子が見えます。
>
> 立上り時間を表示するように修正し、IDEではなくEXEを
> 直接実行させても同じく6.5秒かかります。
> (=IDEが原因ではない)
>
> 質問1:TTask.Createの立上りはこんなに遅いものでしょうか？
>
> 質問2:立上りを早めることができますでしょうか？
>
> 質問3:できない場合、TTask.Create以外で短時間で
> 　　　立ち上がる使い易いThreadはありますでしょうか？
>
> 実際の運用では20個のタスクを立ち上げます。
> この時は16.5秒もかかり実用に耐えません。
> ご指導よろしくお願いします。

　TTask ではないのですが、たくさんのスレッドをほぼ
同時に起動させるテストを行ったことがありますので、
その時のテストプログラムをあらためて試してみました。
それによると、スレッド２００個くらいでしたら０．１～
０．７［秒］で起動するようです。　環境は下記の
とおりです。

　　Celeron 2.66GHz
　　Windows XP SP3、３２ビット

TThread オブジェクトをインスタンスの作成直後に Resume
しており、スレッド処理（TThread.Execute）の中には無限
ループと Sleep(1) を入れています。　tonbo さんと同じ
条件です。

　TTask も内部的には同じようなことをしているはず
ですので、おそらくは TTask 自体の問題ではないように
思います。　お試しになりたい場合には、テストプログラムを
さし上げますのでご連絡ください。

　また少なくとも、TThread を直接使えば、起動に時間が
かかることはありません。

　直接の解決になっていませんが、ご参考になればと思います。
――――――――――――――――――――――――――――――――――――
株式会社イマジオム 代表取締役 高木太郎
〒３１６－００２４ 茨城県 日立市 水木町 １－１１－１０
電話：０２９４－２８－０１４７
ファクシミリ：０２９４－２８－０１４８
携電子メール：tarou_...@imageom.co.jp
ホームページ：http://www.imageom.co.jp/


MLホームページ: http://www.freeml.com/delphi-users

----------------------------------------------------------------------
お名前.comからご案内です。
「.shop」はどなたでも何個でも！
1個1,980円(税抜)で登録いただけます
▼今すぐ「.shop」を登録▼　
http://ad.freeml.com/cgi-bin/sa.cgi?id=pvRUh
------------------------------------------------------[freeml byGMO]--

[Fukushi]

tonboさん、こんにちは。福士です。

> FormにButton 2つ(タスク開始、タスク終了)を貼り付け、
> IDE上で、表示/デバッグ/スレッドで「スレッドの状態」を
> 表示しながら、以下のプログラムを実行します。
> 4つのタスクは即立ち上がるのですが、5つ目から
> 1つ1秒づつかかり、10個全て立ち上がるのに6.5秒
> かかる様子が見えます。
>
> 立上り時間を表示するように修正し、IDEではなくEXEを
> 直接実行させても同じく6.5秒かかります。
> (=IDEが原因ではない)

ちょっと見てみました。TTaskはStartが呼び出されると内部で
キューされ、スレッドプールTThreadPool.Currentにプールされている
スレッド上で実行されるのですが、このとき

System.Threading.TThreadPool.MinWorkerThreads
http://docwiki.embarcadero.com/Libraries/Berlin/ja/System.Threading.TThreadPool.MinWorkerThreads

(tonboさんの環境ではおそらく4、CPUの論理コア数)までのスレッドは
すぐにスタートするのに対し、これを越えるとプールに戻されたスレッドを
再利用しようとするため、すぐにはスタートしないようになっている
ようです(プールが枯渇しているために順次新しいスレッドを起動して
ゆくので時間がかかる)。ですので20個のタスクを使うことがわかっている
のであれば、あらかじめ

| TThreadPool.Current.SetMinWorkerThreads(20);

としておくことで最初の20個のタスクはすぐに起動するようになります。

# タスクは指定された処理が済んだらすぐに終了してスレッドプールに
# 戻されることが前提なのでこのような仕様になっているものと
# 考えられます。

参考にしてください。

---
東洋テクニカルシステム株式会社 システム開発部 福士 光
Hikaru Fukushi (Toyo Technical System Inc.)
mailto:fuk...@tts-inc.co.jp


MLホームページ: http://www.freeml.com/delphi-users

----------------------------------------------------------------------
◇◆オリックス銀行カードローン◆◇
限度額３００円まで所得証明書不要
　「おまとめ・借り換えОＫ！」
　提携ＡＴМご利用手数料０円
http://ad.freeml.com/cgi-bin/sa.cgi?id=pvTr8
------------------------------------------------------[freeml byGMO]--

[tonbo]

（Outlookからの返信でミスし返事が遅れましたことをお詫びします）

高木様
tonboです。

お世話になっております。
わざわざテストいただきありがとうございました。

後で、書かれていますアドレスにメールを差し上げます。
よろしくお願いいたします。

☆世界初☆17種類以上のお茶がワンタッチで楽しめる
ネスレのカプセル式お茶マシン「スペシャル.T」を今なら無料でお試し！
あなたの想像を超えるお茶の世界を♪♪
http://ad.freeml.com/cgi-bin/sa.cgi?id=pwk4g
------------------------------------------------------[freeml byGMO]--

[tonbo]

福士様

tonboです。
詳しく解説頂きありがとうございました。
確かにコアは4つです。

アドバイスに従い次のように修正して、msで立ち上がることを
確認しました。
お気づきの点等ご指摘頂ければ幸いです。

ありがとうございました。

ThreadPool : TThreadPool;

tasks : array of ITask;
TaskStop : Boolean;


procedure TForm1.Button1Click(Sender: TObject);

begin
ThreadPool := TThreadPool.Create;
ThreadPool.SetMinWorkerThreads(10);

Setlength (tasks ,10);

TaskStop := False;

tasks[0] := TTask.Create (Task0, ThreadPool);
tasks[0].Start;

tasks[1] := TTask.Create (Task1, ThreadPool);
tasks[1].Start;

tasks[2] := TTask.Create (Task2, ThreadPool);
tasks[2].Start;

tasks[3] := TTask.Create (Task3, ThreadPool);
tasks[3].Start;

tasks[4] := TTask.Create (Task4, ThreadPool);
tasks[4].Start;

tasks[5] := TTask.Create (Task5, ThreadPool);
tasks[5].Start;

tasks[6] := TTask.Create (Task6, ThreadPool);
tasks[6].Start;

tasks[7] := TTask.Create (Task7, ThreadPool);
tasks[7].Start;

tasks[8] := TTask.Create (Task8, ThreadPool);
tasks[8].Start;

tasks[9] := TTask.Create (Task9, ThreadPool);

tasks[9].Start;
end;

procedure TForm1.Button2Click(Sender: TObject);

begin
TaskStop := True;
ThreadPool.Free;

今までダイエットに失敗してきたあなた
必見です！！やせる事に特化した専門店
ミスパリダイエットセンター☆彡☆彡
今なら、５,０００円で体験実施中♪
http://ad.freeml.com/cgi-bin/sa.cgi?id=pwkIs
------------------------------------------------------[freeml byGMO]--