VPF::многопоточность - Форум программистов

Norfonzor

Дата 14.1.2010, 16:09 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 121
Регистрация: 17.10.2008

Репутация: нет
Всего: нет

Здравствуйте, мне нужна программа которая выполняет следующее:

запускаются 4 потока "одновременно"
каждый поток вычисляет много операций сложения, например сумма от 1 до 100000.
(процессор должен переключаться между подсчетами потоков)

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

кто нибудь дайте пример программы такой, сегодня 8 часов сидел пытался написать прогу такую и переделать(о думающих философах и еще какие то были) , ничего не вышло.

читал тему "Многопоточность - как это делается в Дельфи. Не используйте потоки, не прочитав это"
не понятно ничего там, лучше бы в коде комментарии были.
помогите пожалуйста!

что должны делать процессы:

Код


procedure process1;
var s,p:integer;
begin
s:=0;
for p:=1 to 100000 do
begin
s:=s+random(strtoint(FmMain.Vb.Text)-strtoint(FmMain.Va.Text))+strtoint(FmMain.Va.Text);
end;
FmMain.endprocess.Caption:=FmMain.endprocess.Caption+#13+'ïðîöåññ 1';
eofprocess1:=true;
end;

procedure process2;
var s,p:integer;
begin
s:=0;
for p:=1 to 50000 do
begin
s:=s+random(strtoint(FmMain.Vd.Text)-strtoint(FmMain.Vc.Text))+strtoint(FmMain.Vc.Text);
end;
FmMain.endprocess.Caption:=FmMain.endprocess.Caption+#13+'ïðîöåññ 2';
eofprocess2:=s;
end;

procedure process3;
var s,p:integer;
begin
s:=0;
s:=random(strtoint(FmMain.Vf.Text)-strtoint(FmMain.Ve.Text))+strtoint(FmMain.Ve.Text);
FmMain.endprocess.Caption:=FmMain.endprocess.Caption+#13+'ïðîöåññ 3';
eofprocess3:=s;
end;

procedure process4;
var s,p:integer;
begin
s:=0;
for p:=1 to 75000 do
begin
s:=s+random(strtoint(FmMain.Vh.Text)-strtoint(FmMain.Vg.Text))+strtoint(FmMain.Vg.Text);
end;
FmMain.endprocess.Caption:=FmMain.endprocess.Caption+#13+'ïðîöåññ 4';
eofprocess4:=s;
end;

procedure process5;
var s,p:integer;
begin
eofprocess5:=(eofprocess1+eofprocess2+eofprocess3)/eofprocess4;
FmMain.endprocess.Caption:=FmMain.endprocess.Caption+#13+'ïðîöåññ 5';
end;

strtoint(FmMain.Va.Text) - strtoint(FmMain.Vh.Text) : вводятся с формы

хотел передалать рпогу про философов, когда разобрался в ней понял что алгоритм выбора работающего процесса мне не подходит да я и не совсем понял при чем тут много поточность
исходник про философов
http://depositfiles.com/files/9apc1zajd

еще нашел исходник вроде там переключение по времяни только мне код не очень понятен
http://depositfiles.com/files/yjmsnymbp

Демо

Дата 14.1.2010, 16:25 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1278
Регистрация: 3.11.2005

Репутация: 6
Всего: 50

Цитата(Norfonzor @ 14.1.2010, 16:09

)

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

Не существует такого алгоритма. Переключением потоков занимается операционная система.
Пользовательский уровень управления - волокна (fiber).

--------------------

Norfonzor

Дата 14.1.2010, 16:41 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 121
Регистрация: 17.10.2008

Репутация: нет
Всего: нет

а как тогда организовать много поточность?

Демо

Дата 14.1.2010, 17:07 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1278
Регистрация: 3.11.2005

Репутация: 6
Всего: 50

Цитата(Norfonzor @ 14.1.2010, 16:41

)

а как тогда организовать много поточность?

Организовать многопоточность без проблем.

Цитата(Norfonzor @ 14.1.2010, 16:09

)

Но вот это условие невыполнимо.
Можно искусственно тормозить каждый поток для передачи управления другим, но заставить поток выполняться именно указанное время, указать, какому потоку работать - невозможно.

--------------------

CodeMonkey

Дата 14.1.2010, 17:54 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1839
Регистрация: 24.6.2008
Где: Россия, Тверь

Репутация: 16
Всего: 89

Цитата(Norfonzor @ 14.1.2010, 16:41

)

а как тогда организовать много поточность?

Вы сначала скажите, с какой целью вы это хотите сделать.

--------------------

Опытный программист на C++ легко решает любые не существующие в Паскале проблемы.

Norfonzor

Дата 14.1.2010, 18:11 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 121
Регистрация: 17.10.2008

Репутация: нет
Всего: нет

я хочу понять как это работает, мне проще понять по примеру, желательно с комментариями.

CodeMonkey

Дата 14.1.2010, 19:46 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1839
Регистрация: 24.6.2008
Где: Россия, Тверь

Репутация: 16
Всего: 89

Плюм и плюх.

Решение задач, особенно типа философов со сложной синхронизацией, я бы отложил на потом. Пока разберитесь с основами. Посмотрите демку в Delphi (сортировка).

--------------------

Опытный программист на C++ легко решает любые не существующие в Паскале проблемы.

Norfonzor

Дата 17.1.2010, 17:25 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 121
Регистрация: 17.10.2008

Репутация: нет
Всего: нет

я пример нашел с много поточностью.

Код


unit Unit1;

interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls;
type
TNewThread = class(TThread)
  private
    Progress: integer;
    //procedure SetProgress;
  protected
    procedure Execute; override;
  end;



const
  PROGRESS_POS = WM_USER+1;
type
  TForm1 = class(TForm)
    ProgressBar1: TProgressBar;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);





  private
  procedure SetProgressPos(var Msg: TMessage); message PROGRESS_POS;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  CriticalSection: TRTLCriticalSection;

implementation
{$R *.dfm}

{ TNewThread }

procedure TNewThread.Execute;
var
  i: integer;
begin
  EnterCriticalSection(CriticalSection);
  for i:=0 to 100 do
  begin
    sleep(10);
    SendMessage(Form1.Handle,PROGRESS_POS,0,i);
  end;
  LeaveCriticalSection(CriticalSection);
end;






procedure TForm1.Button1Click(Sender: TObject);
var
  NewThread: TNewThread;
begin
  NewThread:=TNewThread.Create(true);
  NewThread.FreeOnTerminate:=true;
  NewThread.Priority:=tpLower;
  NewThread.Resume;

end;


procedure TForm1.SetProgressPos(var Msg: TMessage);
begin
  ProgressBar1.Position:=Msg.LParam;
end;



procedure TForm1.FormCreate(Sender: TObject);
begin
InitializeCriticalSection(CriticalSection);
end;

end.

это не то что мне нужно.

ПОМОГИТЕ КТО НИБУДЬ!

это разве такая сложная задача?

4 процесса одновременно стартуют результат выполнения по очереди выполнится напишет в лейбл что он финишировал.

Демо

Дата 17.1.2010, 17:39 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1278
Регистрация: 3.11.2005

Репутация: 6
Всего: 50

Цитата(Norfonzor @ 17.1.2010, 17:25

)

это разве такая сложная задача?

Это - не сложная.

Цитата(Norfonzor @ 14.1.2010, 16:09

)

Эта - сложная.

--------------------

Norfonzor

Дата 17.1.2010, 18:16 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 121
Регистрация: 17.10.2008

Репутация: нет
Всего: нет

вот что мне нужно было:

Код


unit Unit1;

interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls;
type

   TMyThread1 = class(TThread)
   private
     { Private declarations }
   protected
     procedure DoWork;
     procedure Execute; override;
   end;

   TMyThread2 = class(TThread)
   private
     { Private declarations }
   protected
     procedure DoWork;
     procedure Execute; override;
   end;

   TMyThread3 = class(TThread)
   private
     { Private declarations }
   protected
     procedure DoWork;
     procedure Execute; override;
   end;

   TMyThread4 = class(TThread)
   private
     { Private declarations }
   protected
     procedure DoWork;
     procedure Execute; override;
   end;

   TMyThread5 = class(TThread)
   private
     { Private declarations }
   protected
     procedure DoWork;
     procedure Execute; override;
   end;

type
  TFmMain = class(TForm)
    Button1: TButton;
    endprocess: TLabel;
    Va: TEdit;
    La: TLabel;
    Vb: TEdit;
    Lb: TLabel;
    Vc: TEdit;
    Lc: TLabel;
    Vd: TEdit;
    Ld: TLabel;
    Ve: TEdit;
    Le: TLabel;
    Vf: TEdit;
    Lf: TLabel;
    Vg: TEdit;
    Lg: TLabel;
    Vh: TEdit;
    Lh: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);





  private

    { Private declarations }
  public
    { Public declarations }
  end;

var
  FmMain: TFmMain;
  CriticalSection: TRTLCriticalSection;
   T1   : TMyThread1;
   T2   : TMyThread2;
   T3   : TMyThread3;
   T4   : TMyThread4;
   T5   : TMyThread5;
   eofprocess1,eofprocess2,eofprocess3,eofprocess4,eofprocess5:real;

implementation
{$R *.dfm}

{ TNewThread }
procedure process1;
var s,p:integer;
begin
s:=0;
for p:=1 to 100000 do
begin
s:=s+random(strtoint(FmMain.Vb.Text)-strtoint(FmMain.Va.Text))+strtoint(FmMain.Va.Text);
end;
FmMain.endprocess.Caption:=FmMain.endprocess.Caption+#13+'процесс 1';
eofprocess1:=s;
T1.Terminate;
end;

procedure process2;
var s,p:integer;
begin
s:=0;
for p:=1 to 50000 do
begin
s:=s+random(strtoint(FmMain.Vd.Text)-strtoint(FmMain.Vc.Text))+strtoint(FmMain.Vc.Text);
end;
FmMain.endprocess.Caption:=FmMain.endprocess.Caption+#13+'процесс 2';
eofprocess2:=s;
T2.Terminate;
end;

procedure process3;
var s,p:integer;
begin
s:=0;
s:=random(strtoint(FmMain.Vf.Text)-strtoint(FmMain.Ve.Text))+strtoint(FmMain.Ve.Text);
FmMain.endprocess.Caption:=FmMain.endprocess.Caption+#13+'процесс 3';
eofprocess3:=s;
T3.Terminate;
end;


procedure process4;
var s,p:integer;
begin
s:=0;
for p:=1 to 75000 do
begin
s:=s+random(strtoint(FmMain.Vh.Text)-strtoint(FmMain.Vg.Text))+strtoint(FmMain.Vg.Text);
end;
FmMain.endprocess.Caption:=FmMain.endprocess.Caption+#13+'процесс 4';
eofprocess4:=s;
T4.Terminate;
end;

procedure process5;
var s,p:integer;
begin
if (eofprocess1<>0)and(eofprocess2<>0)and(eofprocess3<>0)and(eofprocess4<>0) then
begin
eofprocess5:=(eofprocess1+eofprocess2+eofprocess3)/eofprocess4;
FmMain.endprocess.Caption:=FmMain.endprocess.Caption+#13+'процесс 5'+#13+'Результат:'+inttostr(round(eofprocess5));
T5.Terminate;

end;

end;

procedure TMyThread1.Execute;
 begin
   {Пока процесс не прервали, выполняем DoWork}
   while not Terminated do
     Synchronize(DoWork);
 end;

 procedure TMyThread2.Execute;
 begin
   {Пока процесс не прервали, выполняем DoWork}
   while not Terminated do
     Synchronize(DoWork);
 end;

procedure TMyThread3.Execute;
 begin
   {Пока процесс не прервали, выполняем DoWork}
   while not Terminated do
     Synchronize(DoWork);
 end;

procedure TMyThread4.Execute;
 begin
   {Пока процесс не прервали, выполняем DoWork}
   while not Terminated do
     Synchronize(DoWork);
 end;

procedure TMyThread5.Execute;
 begin
   {Пока процесс не прервали, выполняем DoWork}
   while not Terminated do
     Synchronize(DoWork);
 end;

 procedure TMyThread1.DoWork;
 begin
    process1;
 end;

 procedure TMyThread2.DoWork;
 begin
    process2;
 end;

  procedure TMyThread3.DoWork;
 begin
    process3;
 end;

  procedure TMyThread4.DoWork;
 begin
    process4;
 end;

  procedure TMyThread5.DoWork;
 begin
    process5;
 end;



procedure TFmMain.Button1Click(Sender: TObject);
 begin
   {Если кнопка называется Stop...}
   if Button1.Caption = 'Stop' then begin
     {Прерываем оба процесса}
     T1.Terminate;
     T2.Terminate;
     T3.Terminate;
     T4.Terminate;
     T5.Terminate;
     {Изменяем название кнопки}
     Button1.Caption := 'Start';
     {Выходим из процедуры}
     Exit;
   end;
   {Создаем и сразу запускаем два процесса}
   T1 := TMyThread1.Create(False);
   T2 := TMyThread2.Create(False);
   T3 := TMyThread3.Create(False);
   T4 := TMyThread4.Create(False);
   T5 := TMyThread5.Create(False);//T5.Terminate;

   {Здесь можно поэкспериментировать с приоритетами: }
    //T1.Priority := tpLowest;
    T1.Priority := tpHighest;
    T2.Priority := tpHighest;
    T3.Priority := tpHighest;
    T4.Priority := tpHighest;
    T5.Priority := tpHighest;

   {Переименовываем кнопку}
   Button1.Caption := 'Stop';
 end;


procedure TFmMain.FormCreate(Sender: TObject);
begin
eofprocess1:=0;
eofprocess2:=0;
eofprocess3:=0;
eofprocess4:=0;
eofprocess5:=0;
end;

end.

Демо

Дата 17.1.2010, 18:34 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1278
Регистрация: 3.11.2005

Репутация: 6
Всего: 50

Цитата(Norfonzor @ 17.1.2010, 18:16

)

вот что мне нужно было:

Вряд ли. Код с грубыми ошибками. Хуже - он даже не будет работать так, как задумывал автор, хотя он, видимо, об этом так и не узнал.

Если бы сформулировал свои вопросы правильно, тебе бы уже давно помогли.

Это сообщение отредактировал(а) Демо - 17.1.2010, 18:36

--------------------

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: WinAPI и системное программирование \| Следующая тема »