Потоки в паскале

[LenOk]

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

[XProger]

Что-то типа этого?

[LenOk]

а разве это на пакскале?)))
надо написать что-то на подобе вот такого:

Код: Выделить всё

uses
  sysutils {$ifdef unix},cthreads{$endif} ;

const
  threadcount = 100;
  stringlen = 10000;

var
   finished : longint;

threadvar
   thri : ptrint;

function f(p : pointer) : ptrint;

var
  s : ansistring;

begin
  Writeln('thread',longint(p),' started');
  thri:=0;
  while (thri<stringlen) do
    begin
    s:=s+'1';
    inc(thri);
    end;
  Writeln('thread ',longint(p),' finished');
  InterLockedIncrement(finished);
  f:=0;
end;

var
   i : longint;

begin
   finished:=0;
   for i:=1 to threadcount do
     BeginThread(@f,pointer(i));
   while finished<threadcount do ;
   Writeln(finished);
end.

Добавлено спустя 2 минуты 19 секунд:
только что бы еще эта задачка реализовала два потока,а эти потоки в свою очередь считали какие то арифметические операции!

[FedeX]

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

Код: Выделить всё

program CoreTest;

{$APPTYPE CONSOLE}
{$MODE DELPHI}
uses SysUtils{$ifdef unix},cthreads{$endif};

procedure MegaLoop(l, r: Integer);
var
  i : Integer;
  rv : single;
begin
  for i := l to r - 1 do
    rv:=sin(i);
end;

var
  t  : TSystemTime;
  ts : TTimeStamp;
  cs : TRTLCriticalSection;

  procedure ThreadProc(p: Pointer); stdcall;
  begin
    EnterCriticalSection(cs);
    MegaLoop(50000000, 100000000);
    LeaveCriticalSection(cs);
  end;

var
  ID : LongWord;
begin
  writeln('Please wait...');
// работа в 1 поток
  write('one : ');
  GetLocalTime(t);
  ts := DateTimeToTimeStamp(SystemTimeToDateTime(t));
  MegaLoop(0, 100000000);
  GetLocalTime(t);
  writeln(DateTimeToTimeStamp(SystemTimeToDateTime(t)).Time - ts.Time, ' mks');

// работа в 2 потока (по одному на каждое ядро)
  InitCriticalSection(cs);
  write('two : ');

  GetLocalTime(t);
  ts := DateTimeToTimeStamp(SystemTimeToDateTime(t));
  BeginThread(@ThreadProc);
  MegaLoop(0, 50000000);

  EnterCriticalSection(cs);
  GetLocalTime(t);
  writeln(DateTimeToTimeStamp(SystemTimeToDateTime(t)).Time - ts.Time, ' mks');
  LeaveCriticalSection(cs);
  DoneCriticalsection(cs);

  writeln('Done!');

  readln;
end.
                                         


Правда GetTickCount пришлось заменить на такую вот белибердень Вообще прикольный пример - у меня второй расчёт реально в два раза скорее выходит..

[LenOk]

а можно поподобрее об этой задаче?)
она запуститься на операционной системе windows и на обычном FreePascal без дополнительных модулей?)))

[Mr.Smart]

Компилируй и запускай хоть под Linux

[LenOk]

а можно в эти потоки запихнуть арифметические операции...
например,чтобы в одном потоке складывались два числа (a+b), во втором потоке складывались еще два числа (c+d), а в основной программе считалось их произведение?!!

[FedeX]

>она запуститься на операционной системе windows и на обычном FreePascal без дополнительных модулей?)))
ага
>а можно поподобрее об этой задаче?)
На этой задаче судя по всему хорошо наблюдать ускорение работы алгоритма при распаралеливании его на несколько потоков, каждый из которых может выполняться на отдельном ядре многоядерного процессора. Если процессор одноядерный то ускорения не будет (даже возможно наоборот). Вместо алгоритма для простоты выщитываеться просто оч. большое количество синусов какого-то числа (процедура MegaLoop). В начале она запускаеться просто в одном потоке (попутно засекаеться время её выполнения и в конце это время печатаеться на экране). Дальше (после комментария "работа в 2 потока") инициализируеться "критическая секция" (это такой системный обьект, который одновременно может активировать процедурой EnterCriticalSection только один поток, если второй поток тоже вызовет эту функцию, то он будет ожидать, тоесть "спать", до тех пор пока другой поток, занявший критическую секцию, не разблокирует её процедурой LeaveCriticalSection). Далее функцией BeginThread создаёться второй поток (ThreadProc). Он входит в критическую секцию и сразу запускает процедуру MegaLoop. Первый поток, создав второго, тоже сразу запускает процедуру MegaLoop. В итоге они выполняют её одновременно (это и есть много поточность). Дальше основной поток вызывает процедуру EnterCriticalSection, но не может покинуть её пока второй поток не завершит свою работу и не вызовет LeaveCriticalSection. Сразу после того как второй поток делает это и разрушаеться, основной поток идёт дальше и выводит пользователю время потраченное на просчёт.

Вроде так)..

>а можно в эти потоки запихнуть арифметические операции...
да можно

[LenOk]

спасибо

[LenOk]

А вот еще одна задачка на потоки, как ее можно переделать так, чтобы в потоках она считала сумму квадратов элементов массива,а на выходе давала произведение этих сумм.
Например: 1-ый массив 1 2 3 4, его сумма квадратов 1+4+9+16=30
2-ой массив 5 6 7 8 9, его сумма квадратов 25+36+49+64+81=255
а в основной программе считалось произведение этих сумм,т.е.255*30=7650
причем массивы считывались из файлов....

Код: Выделить всё

program f1;

{$mode objfpc}{$H+}

uses
  sysutils {$ifdef unix}, cthreads{$endif};

var
  Sum,Fin:longint;
  mutex:TRTLCriticalSection;
function f(p:pointer):ptrint;

var n,i,g,d,pr:longint;
    mas: array[1..100] of longint;
    inp:TextFile;

begin
writeln('thread ',longint(p),'started');
EnterCriticalSection(mutex);
Try
assignFile(inp, 'input.txt');
reset(inp);
g:=0;
while not eof(inp) do
begin
g:=g+1;
readln(inp, mas[i]);
end;
Finally
close(inp);
LeaveCriticalSection(mutex);
end;
d:=random(g)+1;
writeln('thread ',longint(p),' choose number: ', mas[d]);
writeln('thread ',longint(p),'finished');
for g:=1 to mas[d] do InterLockedIncrement(Sum);
InterLockedIncrement(Fin);
f:=0;
end;

var
  x,k:longint;

begin
randomize;
x:=2;
Fin:=0;
InitCriticalSection(mutex);
for k:=1 to x do
BeginThread(@f,pointer(k));
while Fin<x do ;

DoneCriticalSection(mutex);
writeln('finished ', Fin,'threads.');
writeln('final summa = ', Sum);
readln;
end.

[Михаил Крамер]

Симафорчики ставить надо....

[LenOk]

а с симафором нужны критические секции?