Intel-овцы ругали OpenMP просили приобщится к tbb
https://www.threadingbuildingblocks.org/
Модератор: Модераторы
sts писал(а):OpenMP делает столько задач сколько доступно потоков...
olegy123 писал(а):Intel-овцы ругали OpenMP просили приобщится к tbb
function Simple_proc(l:pointer):Integer; stdcall;
type TArr = array[0..0] of record r,g,b:byte; end;
var i, j, t, _r, _g, _b, cnt,_x,_y: integer;
row:pointer;
begin
Result := 0;
with PThreadRec(l)^ do
for j := Start to Start + Size-1 do
begin
row := Src.ScanLine[j];
for i := 0 to bmp.Width-1 do
begin
cnt := 0;
_r := 0;
_g := 0;
_b := 0;
for t := 0 to step*step-1 do
begin
_x := i + t mod step - d_step;
_y := j + t div step - d_step;
if (_x >= 0)and(_x < bmp.Width)and(_y >= 0)and(_y < bmp.Height)then
with TArr(Bmp.ScanLine[_y]^)[_x] do begin
inc(cnt);
inc(_r,r);
inc(_g,g);
inc(_b,b);
end;
end;
with TArr(row^)[i] do
begin
r := _r div cnt;
g := _g div cnt;
b := _b div cnt;
end;
end;
end;
end;
procedure THIPBlur.Simple;
var rc:PThreadRec;
i,c:integer;
id:LongWord;
lpSystemInfo:_SYSTEM_INFO;
FEvents:array of cardinal;
lst:PList;
begin
bmp.PixelFormat := pf24bit;
src.PixelFormat := pf24bit;
if(bmp.Width > 256)and(bmp.Height > 256)then
begin
GetSystemInfo(lpSystemInfo);
c := lpSystemInfo.dwNumberOfProcessors;
end
else c := 1;
lst := NewList;
SetLength(FEvents, c);
for i := 1 to c do
begin
new(rc);
rc.src := src;
rc.bmp := bmp;
rc.size := bmp.height div c;
rc.Start := (i-1)*rc.size;
rc.handle := CreateThread(0, 0, @Simple_proc, rc, 0, id);
FEvents[i-1] := rc.handle;
lst.Add(rc);
SetThreadPriority(rc.handle, THREAD_PRIORITY_HIGHEST);
end;
WaitForMultipleObjects(c, PWOHandleArray(@FEvents[0]), true, cardinal(-1));
for i := 0 to c-1 do
begin
CloseHandle(FEvents[i]);
dispose(PThreadRec(lst.Items[i]));
end;
lst.Free;
end;
Alex2013 писал(а):И чем это go сильно отличается от чего-то вроде этого кода ?
Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 29