VPF::OpenCL в Delphi XE2 под Win64bit - Форум программистов

Prok12

Дата 4.3.2016, 08:14 (ссылка)

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

Загрузка ...

Новичок

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

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

Суть проблемы. Есть весьма объёмный ПК для научных расчётов: интерфейс, База данных, много-поточные расчёты (на CPU пока), графика 2D, графика 3D на OpenGL, анимация результатов в виде компрессированного avi-файла на выходе - всё делалось на Delphi XE2...XE6 и прекрасно работает. Надо подключить модуль для переноса части длительных фрагментов расчёта на GPU. Этот модуль пытались писать на Visual Studio 2015 - расширение языка C++ AMP, как DLL: работает, но криво: не на всех видеокартах, увы (текст тестовой программы выложен в той же папке для скачивания - см.ниже). Ну и вечная проблема с недостающими DLL к тому что написано на Visual Studio: даже опции компилятора /MT не помогают... На JAVA тоже сейчас мои коллеги пишут этот расчётный модуль - через OpenCL... Ну не в этом вопрос. Есть примеры использования библиотеки OpenCL.dll прямо в проектах Delphi (чехи, например, делали, есть ещё компоненты от MITOV для Delphi Seattle - http://www.mitov.com/ ). Эти несложные примеры работают, но...только при компиляции под Win32, а компилируешь проект Delphi под Win64 - затык...
-----
Сейчас вроде , удалось траблы победить, и сделать работоспособный тест. smile

-----
Вот ссылка для скачивания: http://gofile.me/2Zesj/C0f3wb1o
========
Там в папке:
========
1) Полезная утилита GPU_Caps_Viewer_Setup_v1.26.0.0.exe для контроля состояния видеокарты, особенно, если нажать кнопку "More GPU Info".
2) OpenCL1_2_Delphi.zip - файл с примером от чехов (Университет Брно, насколько помню) использования OpenCL в Delphi, 2013год. У меня этот пример не всегда корректно работал при компиляции под Win64 (не на всех видео-картах). Но там хороший заголовочный файл CL.pas - его можно чуть доработать : заменить тип size_t на NativeInt для Win64, и использовать вместо моего "укороченного" MyOpenCL.pas - см.ниже.
---
3) Вложенная папка OpenCL for Delphi 32bit_64bit с моим вариантом программы-теста. Она самодостаточна: больше ничего не надо, ну разве что последние версии видео-драйверов установить. Тест сделан под Delphi XE2 (работает и под XE6). Причём работает, по крайней мере у меня, при компиляции под Win32, и что более важно- под Win64. Всего 2 файла:
--> MyOpenCL.pas: заголовочный; я его урезал - убрал ненужные мне функции, которые в принципе можно взять из файла чехов CL.pas + учёл полезное замечание с др.форума про NativeInt ;
--> FMain.pas : тестовая программа. Выделяет на GPU память (создаёт буферы) под 16 массивов (квадратных матриц из cl_Float - по 4 байта, размер стороны которых задаётся на основной форме, по умолчанию 1200) и под ещё один массив, того же размера, куда пишется результат несложных вычислений на GPU. Потом запускается итерационный цикл (количество итераций - для проверки времени работы - задаётся тоже на форме, по умолчанию - 12). Внутри каждой итерации 16 массивов заполняются данными, затем запускается ещё и внутренний цикл: 30 проходов вызова расчётного ядра на GPU. Такая структура тестовой программы больше всего подходит под наши научные задачи (вычислит. гидродинамика), но пока это лишь тест. В тесте есть несложная проверка правильности вычислений - для одного из элементов матрицы-результата, поскольку НЕ все драйверы видеокарт (особенно старые) могут диагностировать Kernel Error.
--> программа на С для ядра - текстовый файл ProgramGPU.CL (должен лежать рядом с MyFirstOpenCL.exe !!): там можно глянуть, что делается с одномерными массивами на GPU. Она прямо передаётся в виде строки на GPU, там копилируется и линкуется - ну как обычно в OpenCL.
Нужная DLL для OpenCL - под Win64 или Win32 - подключится из системных папок Windows автоматически, в зависимости от компиляции.
----
4) Можете на своём сетапе запустить прямо готовый MyFirstOpenCL.exe (это версия 64bit !!) с параметрами:
--> размер стороны матрицы = 3200; лезут 17 таких матриц на видеокарту от 1Gb и выше; если не влезут (часть видео-памяти уже занята чем-то - GPU_Caps_Viewer в помощь) - возможны ошибки, которые диагностируются НЕ всем драйверами видеокарт, а только новыми;
--> количество итераций (внешний цикл) = 12.
---
5) У меня для указанного примера время счёта вышло (на работе несколько компов):
NVIDIA GT-430 (1Gb, 96core, 700MHz core) - 3мин 37сек;
NVIDIA GTS-450 (1Gb, 192core, 810MHz core) - 1мин 36сек;
NVIDIA GTX-570 (1.28Gb, 480core, 732MHz core) - 42.5сек;
AMD Radeon R9 M275X (2Gb, 640core, 925MHz core) - 1мин 27сек - настольный моноблок ASUS 2702;
NVIDIA GT-545 (3Gb, 144core, 720MHz core) - 2 мин 50сек (тестировали на др. форуме);
NVIDIA GTX-980 (4Gb, 2048 CUDA Cores, 1278MHz) - 25.8сек (тестировали на др. форуме).
===
Тестировал мои коллеги:
NVIDIA GeForce GTX 780 Ti (3Gb, 2880 CUDA Cores, 876MHz) - 23,6сек
NVIDIA GeForce GTX 750 Ti (2Gb, 640 CUDA Cores, 1020MHz) - 43.7сек
NVIDIA GeForce GTX 980 Ti (6Gb, 2816 CUDA Cores, 1190MHz Boost, MSI) - 22.1сек - установил такой акселератор в свой комп (09.02.16).
----
Может кто-то попробовать MyFirstOpenCL.exe на своих видеокартах??? smile

Особенно интересуют последние AMD Radeon !! Поскольку это проект дельфовый, никакие внешние DLL ему не нужны (кроме тех что в Windows у всех есть), как и всякие - джава-машины: только для видео-карты новые драйверы желательны.
Запустить, нажать верхнюю кнопку на форме, установить размер матрицы 3200 (если 1200 отработает корректно), выбрать платформу-девайс, нажать нижнюю кнопку на форме. Записать время счёта: оно выдаётся в итоговом окне.
Нам сейчас на работу надо будет покупать новую карту 6-8Gb именно для расчётов...денег более 60тр вряд ли выделят... AMD конечно подешевле, но... Такие сопоставительные тесты на задачах, приближенных к нашим, были бы полезны!! Были бы полезны и замечания участников форума по тестовой программе. Вообще, жду выхода в этом году Nvidia PASCAL (1080ti, к примеру)...
===
К сожалению, у меня нет под рукой видео-карты (акселератора) с памятью на борту 8Gb-12Gb. Было бы интересно протестить и на таких "монстрах", повышая понемногу размер входной матрицы (требуемую память тестовая программа сообщит в начале работы): для того и писалось под Win64 - нужна большая память. Буду признателен! smile

===
ПыСы. В ту же папку для скачивания добавил:
1) Новый тестовый пример на Delphi XE2 - в под-папке OpenCL_Demo2016 . Там тестирование с проверкой и сопоставлением расчётов на CPU и на GPU. Да и более культурно текст переписал (исходники все выкладываю!!) Не забудьте, что рядом с EXE должны "лежать" 2 программки-KERNEL (здесь расширение у них не *.CL как в старом тесте, а *.cpp - так их редактор Delphi лучше понимает).
2) В отдельной под-папке внутри OpenCL_Demo2016 примеры моих программок для видеодрайвера (на языке C99) - так называемых KERNEL...

Prok12

Дата 28.12.2017, 13:59 (ссылка)

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

Загрузка ...

Новичок

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

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

Дополню (конец декабря 2017). Внутри той же ссылки для скачивания http://gofile.me/2Zesj/C0f3wb1o добавил папку:

OpenCL_Demo2017 Barrier and Local_Memory REDUCT

В ней новый пример под Delphi XE8 64bit (работает и при компиляции в Delphi под Win32, но с ограничениями, о которых будет сказано ниже).

Отличия:
1. Добавлен пример простейшей редукции с использованием barrier и LocalMemory с обилием комментариев внутри Kernel-файла ProgramGPU1.cpp

2. Показано, как внутри Kernel создать а-ля динамический массив (стандарт языка OpenCL 1.2 этого не позволяет).

3. Главное. На форме (см. вложенный в новую папку для скачивания скан экрана) добавлены Gauge-компоненты,
показывающие:

общую загрузку CPU ;
загрузку CPU данной задачей ;
загрузку GPU (общую);
загрузку контроллера памяти GPU - только для NVIDIA;
проценты использованной памяти GPU - только для NVIDIA;
потребляемую мощность GPU - в Ваттах, только для NVIDIA;
температуру GPU (в текстовом виде, град. С);
частоту вращения вентилятора GPU (в текстовом виде, %);
частоты GPU и памяти GPU в данное время (в текстовом виде, MHz).

4. Для определения загрузки GPU-NVIDIA используется nvml.dll  - мануал 2017 здесь :
https://docs.nvidia.com/deploy/pdf/NVML_API...rence_Guide.pdf ,
причём "проценты использованной памяти" определяются только для карт NVIDIA, и при компиляции в Delphi под 64bit. Эта динамич. библиотека для каждой карты NVIDIA - своя, обычно при установке драйвера карты она попадает в папку
C:\Program Files\NVIDIA Corporation\NVSMI\nvml.dll (этот путь прямо прописан в прилагаемом примере по ссылке).
Всё что связано с определением загрузки CPU-GPU находится в отдельном модуле ProcessorUsage.pas, который может быть применён и для других программ (без OpenCL).

5. Если есть желание попробовать OpenCL не только на видеокартах, но и на процессорах INTEL, надо поставить драйвер https://software.intel.com/en-us/articles/o...est_CPU_runtime

6. Буду весьма признателен, если кто-то подскажет способ измерения загрузки памяти GPU от AMD, Есть похожая DLL - как у NVIDIA, только для AMD Radeon?
Может, эти: atiadlxx.dll  ,  atiadlxy.dll  ,  GPUPerfAPIGL.dll  ?   smile

Первую из них уже частично использовал для определения загрузки GPU-AMD, температуры, частот, скорости Карлсона AMD, (но не занятой/свободной памяти AMD!).
Документация atiadlxx.dll частично есть в папке Supporting Information : в ней надо открыть в любом броузере ADL_SDK.html.
-------------------------
7. Ещё раз напоминаю, что при запуске *.exe рядом с ним должны лежать два текстовых файла *.cpp - они будут отправлены на компиляцию драйверу видеокарты!

8. Пример делался в Delphi XE8, компилировался под 64bit. Система - Windows 10Pro. При компиляции под 32bit не будут отображаться компоненты загрузки GPU (даже если у вас карта NVIDIA, и по указанному пути удастся найти библиотеку nvml.dll). Кроме того, из-за ограничений в адресации памяти под 32bit, максимальный размер матриц 1400 x 8 (так и задано по умолчанию на форме).
Скан экрана при работе этой тестовой программы (Reduct DEMO.tiff) есть в указанной новой папке.

Дублирую здесь содержимое файла ProcessorUsage.pas (от 24.01.18) для измерения загрузки CPU-GPU-NVIDIA-AMD (хотя он есть в папке для скачивания):

код Pascal/Delphi

10:

11:

12:

13:

14:

15:

16:

17:

18:

19:

20:

21:

22:

23:

24:

25:

26:

27:

28:

29:

30:

31:

32:

33:

34:

35:

36:

37:

38:

39:

40:

41:

42:

43:

44:

45:

46:

47:

48:

49:

50:

51:

52:

53:

54:

55:

56:

57:

58:

59:

60:

61:

62:

63:

64:

65:

66:

67:

68:

69:

70:

71:

72:

73:

74:

75:

76:

77:

78:

79:

80:

81:

82:

83:

84:

85:

86:

87:

88:

89:

90:

91:

92:

93:

94:

95:

96:

97:

98:

99:

100:

101:

102:

103:

104:

105:

106:

107:

108:

109:

110:

111:

112:

113:

114:

115:

116:

117:

118:

119:

120:

121:

122:

123:

124:

125:

126:

127:

128:

129:

130:

131:

132:

133:

134:

135:

136:

137:

138:

139:

140:

141:

142:

143:

144:

145:

146:

147:

148:

149:

150:

151:

152:

153:

154:

155:

156:

157:

158:

159:

160:

161:

162:

163:

164:

165:

166:

167:

168:

169:

170:

171:

172:

173:

174:

175:

176:

177:

178:

179:

180:

181:

182:

183:

184:

185:

186:

187:

188:

189:

190:

191:

192:

193:

194:

195:

196:

197:

198:

199:

200:

201:

202:

203:

204:

205:

206:

207:

208:

209:

210:

211:

212:

213:

214:

215:

216:

217:

218:

219:

220:

221:

222:

223:

224:

225:

226:

227:

228:

229:

230:

231:

232:

233:

234:

235:

236:

237:

238:

239:

240:

241:

242:

243:

244:

245:

246:

247:

248:

249:

250:

251:

252:

253:

254:

255:

256:

257:

258:

259:

260:

261:

262:

263:

264:

265:

266:

267:

268:

269:

270:

271:

272:

273:

274:

275:

276:

277:

278:

279:

280:

281:

282:

283:

284:

285:

286:

287:

288:

289:

290:

291:

292:

293:

294:

295:

296:

297:

298:

299:

300:

301:

302:

303:

304:

305:

306:

307:

308:

309:

310:

311:

312:

313:

314:

315:

316:

317:

318:

319:

320:

321:

322:

323:

324:

325:

326:

327:

328:

329:

330:

331:

332:

333:

334:

335:

336:

337:

338:

339:

340:

341:

342:

343:

344:

345:

346:

347:

348:

349:

350:

351:

352:

353:

354:

355:

356:

357:

358:

359:

360:

361:

362:

363:

364:

365:

366:

367:

368:

369:

370:

371:

372:

373:

374:

375:

376:

377:

378:

379:

380:

381:

382:

383:

384:

385:

386:

387:

388:

389:

390:

391:

392:

393:

394:

395:

396:

397:

398:

399:

400:

401:

402:

403:

404:

405:

406:

407:

408:

409:

410:

411:

412:

413:

414:

415:

416:

417:

418:

419:

420:

421:

422:

423:

424:

425:

426:

427:

428:

429:

430:

431:

432:

433:

434:

435:

436:

437:

438:

439:

440:

441:

442:

443:

444:

445:

446:

447:

448:

449:

450:

451:

452:

453:

454:

455:

456:

457:

458:

459:

460:

461:

462:

463:

464:

465:

466:

467:

468:

469:

470:

471:

472:

473:

474:

475:

476:

477:

478:

479:

480:

481:

482:

483:

484:

485:

486:

487:

488:

489:

490:

491:

492:

493:

494:

495:

496:

497:

498:

499:

500:

501:

502:

503:

504:

505:

506:

507:

508:

509:

510:

unit ProcessorUsage;

{=====================================================================}

{**** Моделирование 3D течений, переноса тепла и деформаций дна. ****}

{==== Модуль определения загрузки CPU (общей и процессом) и GPU ====}

{========= Прокофьев В.А. АО "ВНИИГ им. Б.Е.Веденеева" ========}

{========= 01.2018 С.Петербург. e-mail: Prok12@Rambler.ru ========}

{=====================================================================}

interface

uses Windows, SysUtils, Dialogs;

// В начале 1 раз вызвать с параметром Initialize = True

procedure CPUusage(const Initialize : Boolean;

out Total, MyProcess, TotalMemory, ProcessMemory : Integer);

//... Температуры выдаются в град.С, частоты- в MHz, ...

//... потребляемая мощность- в Ваттах, остальное- в % ...

procedure GPUusageInitialize; // Запустить 1 раз в начале

procedure GPUusageNVIDIA(const GPU_num : Byte;

out GPU_usage, MemoryController, Memory, Temperature,

GPU_freq, MEM_freq, FanSpeed, Power : Integer);

procedure GPUusageAMD(const GPU_num : Byte;

out GPU_usage, Temperature, GPU_freq, Mem_freq, FanSpeed : Integer);

procedure GPUusageShutdown; // Запустить 1 раз в конце

type TypeGPU = (gpuNO = 0, gpuNVIDIA = 1, gpuAMD = 2);

var Initialize_NVIDIA_OK : Boolean = False;

Initialize_AMD_OK : Boolean = False;

//=====================================================================

implementation

//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

//++++++++++++++++ Сначала работаем с загрузкой CPU +++++++++++++++++++

//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

var OldIdleTime64, OldSysTime64, OldProcT64 : Int64;

{==== Определение размера выделенной приложению памяти (в Байтах) ====}

function MyGetAllocatedMemory: UInt64;

var St: TMemoryManagerState; Sb: TSmallBlockTypeState;

begin

GetMemoryManagerState(St);

Result := St.TotalAllocatedMediumBlockSize +

St.TotalAllocatedLargeBlockSize;

For Sb in St.SmallBlockTypeStates do

Result := Result + Sb.UseableBlockSize * Sb.AllocatedBlockCount;

end;

//=====================================================================

//========== Определение загрузки CPU (в процентах 0..100) ============

//=====================================================================

procedure CPUusage(const Initialize : Boolean;

out Total, MyProcess, TotalMemory, ProcessMemory : Integer);

var IdleTime, CreationTime, ExitTime, KernelTime, UserTime : TFileTime;

IdleTime64, KernelTime64, UserTime64, NewProcT64, DIdle, Dsum : Int64;

MemStatusCPU: TMemoryStatus;

begin

Try

Dsum := 1; //... только чтобы не было Warning

//=== 1) Определим загрузку CPU всеми процессами в системе (Total) ====

GetSystemTimes(IdleTime, KernelTime, UserTime);

// См. https://www.codeproject.com/Articles/9113/

// Get-CPU-Usage-with-GetSystemTimes

Move(IdleTime, IdleTime64, 8);

Move(KernelTime, KernelTime64, 8); Move(UserTime, UserTime64, 8);

If Initialize then Total := 0 else begin

DIdle := IdleTime64 - OldIdleTime64;

Dsum := KernelTime64 + UserTime64 - OldSysTime64;

If Dsum <= 0 then DSum := 1;

// KernelTime включает в себя и IdleTime !

Total := Round(100.0 * (Dsum - Didle) / Dsum);

If Total < 0 then Total := 0;

If Total > 100 then Total := 100;

end;

OldIdleTime64 := IdleTime64; // Время простоя CPU

// Общее время, включая простой

OldSysTime64 := KernelTime64 + UserTime64;

//=== 2) Определим загрузку CPU только нашим процессом (MyProcess) ====

GetProcessTimes(GetCurrentProcess, CreationTime,

ExitTime, KernelTime, UserTime);

Move(KernelTime, KernelTime64, 8); Move(UserTime, UserTime64, 8);

NewProcT64 := KernelTime64 + UserTime64;

// Dsum- интервал астрономического времени между 2-мя вызовами CPUusage

If Initialize then MyProcess := 0 else

MyProcess := Round(100.0 * (NewProcT64 - OldProcT64) / Dsum);

If MyProcess < 0 then MyProcess := 0;

If MyProcess > 100 then MyProcess := 100;

OldProcT64 := NewProcT64;

//=============== 3) Определим загрузку памяти CPU ====================

MemStatusCPU.dwLength := SizeOf(MemStatusCPU);

GlobalMemoryStatus(MemStatusCPU);

TotalMemory := MemStatusCPU.dwMemoryLoad; // Всего занято процентов

ProcessMemory := Round(100 * MyGetAllocatedMemory /

MemStatusCPU.dwTotalPhys); // Только нашим процессом, в процентах

except

Total := 0; MyProcess := 0;

TotalMemory := 0; ProcessMemory := 0;

end;

//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

//+++++++++++ Далее работаем с имеющимися в системе GPU +++++++++++++++

//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

type Empty_Record = record end; // По аналогии с OpenCL Headers

nvmlDevice_t = ^Empty_Record; // в Header-файле для MS C++ также

p_nvmlDevice_t = ^nvmlDevice_t;

nvmlReturn_t = Integer;

//..... Для определения загрузки GPU и контроллера памяти NVIDIA ......

nvmlUtilization_t = packed record

GPU, Mem : UInt;

end;

p_nvmlUtilization_t = ^nvmlUtilization_t;

//......... Для определения процентной загрузки памяти NVIDIA .........

nvmlMemory_t = packed record

Total, Free, Used : UInt64;

end;

p_nvmlMemory_t = ^nvmlMemory_t;

//~~~~ Clock types (для определения частот GPU и Memory у NVIDIA) ~~~~~

const NVML_CLOCK_GRAPHICS = 0; // Graphics clock domain

NVML_CLOCK_MEM = 2; // Memory clock domain

var // Описываем прототипы вызываемых из nvml.dll функций

nvmlInit : function() : nvmlReturn_t; stdcall;

nvmlShutdown : function() : nvmlReturn_t; stdcall;

//.....................................................................

nvmlDeviceGetCount : function(pDevCount: pUInt) :

nvmlReturn_t; stdcall;

//.....................................................................

nvmlDeviceGetHandleByIndex : function (GPUnum : UInt;

pHandle: p_nvmlDevice_t) : nvmlReturn_t; stdcall;

//.....................................................................

nvmlDeviceGetUtilizationRates : function (GPU_Handle1 : nvmlDevice_t;

pUtilization: p_nvmlUtilization_t) : nvmlReturn_t; stdcall;

//.....................................................................

nvmlDeviceGetMemoryInfo : function(GPU_Handle1 : nvmlDevice_t;

pDeviceMem: p_nvmlMemory_t) : nvmlReturn_t; stdcall;

//.....................................................................

nvmlDeviceGetTemperature : function(GPU_Handle1 : nvmlDevice_t;

SensorType : Integer; pTemp : pUInt) : nvmlReturn_t; stdcall;

//.....................................................................

nvmlDeviceGetClockInfo : function(GPU_Handle1 : nvmlDevice_t;

ClockType: Integer; Clock : pUInt) : nvmlReturn_t; stdcall;

//.....................................................................

nvmlDeviceGetFanSpeed : function(GPU_Handle1 : nvmlDevice_t;

speed: pUInt) : nvmlReturn_t; stdcall;

//.....................................................................

nvmlDeviceGetPowerUsage : function(GPU_Handle1 : nvmlDevice_t;

pPower : pUint) : nvmlReturn_t; stdcall;

//+++++++++++ Типы для библиотечных функций atiadlxx.dll ++++++++++++++

// (AMD - GPU)

// MyMALLOC подсмотрел здесь : http://www.delphipraxis.net/

// 131660-uebersetzung-c-pascal-callback-zugriffsverletzung.html

type tADL_MAIN_MALLOC_CALLBACK = function(iSize : Integer) :

Pointer; stdcall;

pADL_MAIN_MALLOC_CALLBACK = ^tADL_MAIN_MALLOC_CALLBACK;

// Указатель на эту ф-ю выделения памяти передаётся в инициализацию AMD

function MyMALLOC(iSize : Integer) : Pointer; stdcall;

begin

Result := AllocMem(iSize);

end;

//...... Для получении информации о загрузке GPU-AMD и частотах .......

type ADLPMActivity = packed record

iSize : Integer; // Must be set to the size of the structure

iEngineClock : Integer; // Current engine frequency [in 10KHz]

iMemoryClock : Integer; // Current memory frequency [in 10KHz]

iVddc : Integer; // Current core voltage.

iActivityPercent : Integer; // GPU utilization.

iCurrentPerformanceLevel : Integer; //Performance level index.

iCurrentBusSpeed : Integer; // Current PCIE bus speed.

iCurrentBusLanes : Integer; // Number of PCIE bus lanes.

iMaximumBusLanes : Integer; // Maximum number of PCIE bus lanes.

iReserved : Integer; // Reserved for future purposes.

end;

pADLPMActivity = ^ADLPMActivity;

//........ Для получении информации о температуре GPU-AMD .............

type ADLTemperature = packed record

iSize : Integer; // Must be set to the size of the structure

iTemperature : Integer; // Temperature in millidegrees Celsius

end;

pADLTemperature = ^ADLTemperature;

//.......... Для получении информации о памяти на борту AMD ...........

type ADLMemoryInfo = packed record

iMemorySize : Int64; // Memory size in bytes

// Только AnsiChar позволяет прочитать тип памяти из следующей строки

strMemoryType: array[0..255] of AnsiChar;

iMemoryBandwidth : Int64; // Memory bandwidth in Mbytes/s.

end;

pADLMemoryInfo = ^ADLMemoryInfo;

//........ Для получении информации о скорости вентилятора AMD ........

const ADL_DL_FANCTRL_SPEED_TYPE_PERCENT = 1;

ADL_DL_FANCTRL_FLAG_USER_DEFINED_SPEED = 1;

type ADLFanSpeedValue = packed record

iSize : Integer; // Must be set to the size of the structure

// Possible values: ADL_DL_FANCTRL_SPEED_TYPE_PERCENT or

// ADL_DL_FANCTRL_SPEED_TYPE_RPM

iSpeedType : Integer;

iFanSpeed : Integer; // Fan speed value

// The only flag for now is: ADL_DL_FANCTRL_FLAG_USER_DEFINED_SPEED

iFlags : Integer;

end;

pADLFanSpeedValue = ^ADLFanSpeedValue;

//=== Функции Overdrive6 работают не на всех системах => Overdrive5 ===

var // Описываем прототипы вызываемых из atiadlxx.dll функций

ADL_Main_Control_Create : function(

callback : pADL_MAIN_MALLOC_CALLBACK;

iEnumConnectedAdapters : Integer) : nvmlReturn_t; stdcall;

//.....................................................................

ADL_Main_Control_Destroy: function() : nvmlReturn_t; stdcall;

//.....................................................................

ADL_Overdrive5_CurrentActivity_Get: function(iAdapterIndex : Integer;

pActivity : pADLPMActivity) : nvmlReturn_t; stdcall;

//.....................................................................

ADL_Adapter_NumberOfAdapters_Get : function(pNumAdapters : pInt) :

nvmlReturn_t; stdcall;

//.....................................................................

ADL_Adapter_Active_Get : function(iAdapterIndex : Integer;

pStatus : pInt) : nvmlReturn_t; stdcall;

//.....................................................................

ADL_Overdrive5_Temperature_Get : function(iAdapterIndex : Integer;

iThermalControllerIndex : Integer;

pTemperature : pADLTemperature) : nvmlReturn_t; stdcall;

//.....................................................................

ADL_Overdrive5_FanSpeed_Get : function(iAdapterIndex : Integer;

iThermalControllerIndex : Integer;

pFanSpeedValue : pADLFanSpeedValue) : nvmlReturn_t; stdcall;

//.....................................................................

ADL_Adapter_MemoryInfo_Get : function(iAdapterIndex : Integer;

pMemoryInfo: pADLMemoryInfo) : nvmlReturn_t; stdcall;

//.....................................................................

var GPU_count_NVIDIA, GPU_count_AMD: Integer; //UInt;

LibHandleNV, LibHandleAMD: hModule;

ShowMessageAMD : Boolean;

//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

//++++ Инициализация функций из библиотек nvml.dll и atiadlxx.dll +++++

//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

procedure GPUusageInitializeNVIDIA; forward;

procedure GPUusageInitializeAMD; forward;

procedure GPUusageInitialize;

begin

GPUusageInitializeNVIDIA;

GPUusageInitializeAMD;

end;

//=====================================================================

//==== Сначала пытаемся инициализировать библиотеку для NVIDIA ======

//=====================================================================

procedure GPUusageInitializeNVIDIA;

//.... По умолчанию устанавливается только версия библиотеки 64bit ....

// См. https://devtalk.nvidia.com/default/topic/525514/

// can-39-t-find-nvml-dll-in-display-drivers/

const nvml_Lib : WideString =

'C:\Program Files\NVIDIA Corporation\NVSMI\nvml.dll';

//.....................................................................

procedure ProcNV(var Fun: Pointer; const FunName: WideString);

begin

FreeAndNil(Fun);

// Здесь 2-ой параметр м.б. либо ANSI, либо Unicode=WideChar - overload

Fun := GetProcAddress(LibHandleNV, PWideChar(FunName));

end;

//.....................................................................

begin

If not Initialize_NVIDIA_OK then try

// Проверим, существует ли по указанному пути файл библиотеки nvml.dll

If not FileExists(nvml_Lib) then raise EAbort.Create('');

// Лучше конкретно писать LoadLibraryW : работаем с Unicode = PWideChar

LibHandleNV := LoadLibraryW(PWideChar(nvml_Lib));

// Если не удалось загрузить библиотеку nvml.dll

If LibHandleNV = 0 then raise EAbort.Create('');

// Определяем адреса всех необходимых процедур из библиотеки NVIDIA

ProcNV(@nvmlInit, 'nvmlInit');

ProcNV(@nvmlShutdown, 'nvmlShutdown');

ProcNV(@nvmlDeviceGetCount, 'nvmlDeviceGetCount');

ProcNV(@nvmlDeviceGetHandleByIndex, 'nvmlDeviceGetHandleByIndex');

ProcNV(@nvmlDeviceGetUtilizationRates,

'nvmlDeviceGetUtilizationRates');

ProcNV(@nvmlDeviceGetMemoryInfo, 'nvmlDeviceGetMemoryInfo');

ProcNV(@nvmlDeviceGetTemperature, 'nvmlDeviceGetTemperature');

ProcNV(@nvmlDeviceGetClockInfo, 'nvmlDeviceGetClockInfo');

ProcNV(@nvmlDeviceGetFanSpeed, 'nvmlDeviceGetFanSpeed');

ProcNV(@nvmlDeviceGetPowerUsage, 'nvmlDeviceGetPowerUsage');

// Инициализация функций библиотеки nvml.dll

If nvmlInit() <> 0 then raise EAbort.Create('');

// Определение кол-ва GPU в конкретной системе : только для контроля

If nvmlDeviceGetCount(@GPU_count_NVIDIA) <> 0 then

raise EAbort.Create('');

Initialize_NVIDIA_OK := True;

except

Initialize_NVIDIA_OK := False; FreeLibrary(LibHandleNV);

end;

//=====================================================================

//====== Далее пытаемся инициализировать библиотеку для AMD =========

//=====================================================================

procedure GPUusageInitializeAMD;

var MaxAMD, iAdapterAMD, StatusAMD : Integer;

//.....................................................................

procedure ProcAMD(var Fun: Pointer; const FunName: WideString);

begin

FreeAndNil(Fun);

// Здесь 2-ой параметр м.б. либо ANSI, либо Unicode(WideChar)- overload

Fun := GetProcAddress(LibHandleAMD, PWideChar(FunName));

end;

//.....................................................................

begin

ShowMessageAMD := True;

If not Initialize_AMD_OK then try

LibHandleAMD := LoadLibraryW(PWideChar(WideString('atiadlxx.dll')));

// Если не удалось загрузить библиотеку atiadlxx.dll

If LibHandleAMD = 0 then raise EAbort.Create('');

// Определяем адреса всех необходимых процедур из библиотеки AMD

ProcAMD(@ADL_Main_Control_Create, 'ADL_Main_Control_Create');

ProcAMD(@ADL_Main_Control_Destroy, 'ADL_Main_Control_Destroy');

ProcAMD(@ADL_Overdrive5_CurrentActivity_Get,

'ADL_Overdrive5_CurrentActivity_Get');

ProcAMD(@ADL_Adapter_NumberOfAdapters_Get,

'ADL_Adapter_NumberOfAdapters_Get');

ProcAMD(@ADL_Adapter_Active_Get, 'ADL_Adapter_Active_Get');

ProcAMD(@ADL_Overdrive5_Temperature_Get,

'ADL_Overdrive5_Temperature_Get');

ProcAMD(@ADL_Overdrive5_FanSpeed_Get,

'ADL_Overdrive5_FanSpeed_Get');

ProcAMD(@ADL_Adapter_MemoryInfo_Get,

'ADL_Adapter_MemoryInfo_Get');

//....... Определяем GPU_HandleAMD (инициализация функций AMD) ........

// 2-ой парметр = 0 : значит, что для всех доступных AMD-устройств

If ADL_Main_Control_Create(@MyMALLOC, 0) <> 0

then raise EAbort.Create('');

//=====> Получаем информацию об общем количестве адаптеров AMD <=======

If ADL_Adapter_NumberOfAdapters_Get(@MaxAMD) <> 0

then raise EAbort.Create('');

//......... Подсчитаем количество активных адаптеров AMD ..............

GPU_count_AMD := 0; // На моноблоке ASUS ET2702i вышло MaxAMD = 6 !

For iAdapterAMD := 0 to MaxAMD - 1 do begin

If ADL_Adapter_Active_Get(iAdapterAMD, @StatusAMD) <> 0

then raise EAbort.Create('');

If StatusAMD <> 0 then Inc(GPU_count_AMD);

end;

//.....................................................................

Initialize_AMD_OK := True;

except

Initialize_AMD_OK := False; FreeLibrary(LibHandleAMD);

end;

procedure NVIDIA_Shutdown; forward;

//=====================================================================

//===== Определение загрузки NVIDIA-GPU с номером GPU_num (от 0) ======

//=====================================================================

procedure GPUusageNVIDIA(const GPU_num : Byte;

out GPU_usage, MemoryController, Memory, // Всё в процентах

Temperature, // degrees C

GPU_freq, MEM_freq, // MHz

FanSpeed, // Скорость вентилятора в процентах

Power : Integer); // Потребляемая мощность в Ваттах

var GPU_Handle : nvmlDevice_t; UtilGPU : nvmlUtilization_t;

MemGPU : nvmlMemory_t; nvmlValue : UInt;

begin

//!!! Значение -1 -это признак, что параметр не удалось определить !!!!

GPU_usage := -1; MemoryController := -1; Memory := -1;

GPU_freq := -1; MEM_freq := -1;

Temperature := -1; FanSpeed := -1; Power := -1;

If Initialize_NVIDIA_OK and (GPU_num < GPU_count_NVIDIA) then try

//=============> Определение Handle для выбранного GPU <===============

If nvmlDeviceGetHandleByIndex(GPU_num, @GPU_Handle) <> 0

then raise EAbort.Create('');

// След. вызовы будут с ошибками, если nvml.dll от другой видеокарты!!

//====> Получаем информацию о загрузке потоковых процессоров GPU <=====

If nvmlDeviceGetUtilizationRates(GPU_Handle, @UtilGPU) = 0

then begin

GPU_usage := UtilGPU.GPU; MemoryController := UtilGPU.Mem;

end;

//=======> Получаем информацию об использовании памяти GPU <===========

If nvmlDeviceGetMemoryInfo(GPU_Handle, @MemGPU) = 0

then Memory := Round( 100 * MemGPU.Used / MemGPU.Total );

//=========> Получаем информацию о температуре NVIDIA-GPU <============

If nvmlDeviceGetTemperature(GPU_Handle, 0, @nvmlValue) = 0

then Temperature := nvmlValue;

//=====> Получаем информацию о частотах процессора и памяти GPU <======

If nvmlDeviceGetClockInfo(GPU_Handle, NVML_CLOCK_GRAPHICS,

@nvmlValue) = 0 then GPU_freq := nvmlValue;

If nvmlDeviceGetClockInfo(GPU_Handle, NVML_CLOCK_MEM,

@nvmlValue) = 0 then MEM_freq := nvmlValue;

//=====> Получаем информацию о скорости вентилятора NVIDIA-GPU <=======

If nvmlDeviceGetFanSpeed(GPU_Handle, @nvmlValue) = 0

then FanSpeed := nvmlValue; //...в процентах, а не в RPM

//=====> Получаем информацию о потребляемой мощности NVIDIA-GPU <======

If nvmlDeviceGetPowerUsage(GPU_Handle, @nvmlValue) = 0

then Power := Round(1E-3 * nvmlValue); //...миллиВатты в Ватты

except

NVIDIA_Shutdown;

end;

// Если не удалось определить ни одного параметра, отключаем библиотеку

If GPU_usage + MemoryController + Memory + GPU_freq + MEM_freq +

Temperature + FanSpeed + Power = -8 then NVIDIA_Shutdown;

end;

procedure AMD_Shutdown; forward;

//=====================================================================

//======= Определение загрузки AMD-GPU с номером GPU_num (от 0) =======

//=====================================================================

procedure GPUusageAMD(const GPU_num : Byte;

out GPU_usage, Temperature, GPU_freq, Mem_freq, FanSpeed : Integer);

var MemoryInfo : ADLMemoryInfo; MemoryType : String;

MyFanSpeed : ADLFanSpeedValue; MyActivity : ADLPMActivity;

MyTemp : ADLTemperature;

const CRLF = #13#10; // Переход на новую строку для ShowMessage

begin

//!!! Значение -1 -это признак, что параметр не удалось определить !!!!

GPU_usage := -1; GPU_freq := -1; MEM_freq := -1;

Temperature := -1; FanSpeed := -1;

If Initialize_AMD_OK and (GPU_num < GPU_count_AMD) then try

//====> Получаем информацию о загрузке потоковых процессоров GPU <=====

MyActivity.iSize := SizeOf(ADLPMActivity);

If ADL_Overdrive5_CurrentActivity_Get(GPU_num, @MyActivity) = 0

then begin

GPU_usage := MyActivity.iActivityPercent;

GPU_freq := Round(0.01 * MyActivity.iEngineClock);

MEM_freq := Round(0.01 * MyActivity.iMemoryClock);

end;

//===========> Получаем информацию о температуре AMD-GPU <=============

MyTemp.iSize := SizeOf(ADLTemperature);

If ADL_Overdrive5_Temperature_Get(GPU_num, 0, @MyTemp) = 0 then

// Температура была в милли-градусах C

Temperature := Round(0.001 * MyTemp.iTemperature);

//======> Получаем информацию о скорости вентилятора AMD-GPU <=========

MyFanSpeed.iSize := SizeOf(ADLFanSpeedValue);

MyFanSpeed.iFlags := ADL_DL_FANCTRL_FLAG_USER_DEFINED_SPEED;

MyFanSpeed.iSpeedType := ADL_DL_FANCTRL_SPEED_TYPE_PERCENT;

If ADL_Overdrive5_FanSpeed_Get(GPU_num, 0, @MyFanSpeed) = 0

then FanSpeed := MyFanSpeed.iFanSpeed;

//...... Один раз покажем информацию о памяти на борту AMD-GPU ........

If ShowMessageAMD then begin

ShowMessageAMD := False;

//===> Получаем информацию об общем количестве памяти на борту GPU <===

If ADL_Adapter_MemoryInfo_Get(GPU_num, @MemoryInfo) = 0

then begin

// Переводим AnsiString --> String , контролируем длину строки

MemoryType := String(MemoryInfo.strMemoryType);

ShowMessage('Active GPU_count_AMD = ' +

IntToStr(GPU_count_AMD) + CRLF +

'Memory (' + MemoryType + ') = ' +

IntToStr(Round(MemoryInfo.iMemorySize / (1024*1024))) +

' MBytes' + CRLF + 'MemoryType string Length = ' +

IntToStr(Length(MemoryType)) + CRLF + 'Memory Bandwidth= ' +

IntToStr(MemoryInfo.iMemoryBandwidth) + ' MBytes/s');

end;

except

AMD_Shutdown;

end;

// Если не удалось определить ни одного параметра, отключаем библиотеку

If GPU_usage + GPU_freq + MEM_freq +

Temperature + FanSpeed = -5 then AMD_Shutdown;

end;

//---------------------------------------------------------------------

//----------- Отключение библиотек nvml.dll и atiadlxx.dll ------------

//---------------------------------------------------------------------

procedure NVIDIA_Shutdown;

begin

If Initialize_NVIDIA_OK then try

Initialize_NVIDIA_OK := False; nvmlShutdown();

finally

FreeLibrary(LibHandleNV);

end;

//.....................................................................

procedure AMD_Shutdown;

begin

If Initialize_AMD_OK then try

Initialize_AMD_OK := False; ADL_Main_Control_Destroy();

finally

FreeLibrary(LibHandleAMD);

end;

//.....................................................................

procedure GPUusageShutdown;

begin

NVIDIA_Shutdown; AMD_Shutdown;

end;

end.

Всех с наступающим Новым годом !!

Это сообщение отредактировал(а) Prok12 - 27.1.2018, 08:51

Prok12

Дата 6.6.2019, 16:46 (ссылка)

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

Загрузка ...

Новичок

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

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

Обновлённая ссылка на DEMO:
Demo 2019
Последняя версия в папке:
OpenCL_Demo2018 Barrier and Local_Memory REDUCT Delphi Tokyo 10.2.2 !! LAST !!

Это сообщение отредактировал(а) Prok12 - 6.6.2019, 17:14

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