1778 lines
52 KiB
ObjectPascal
1778 lines
52 KiB
ObjectPascal
(* ****************************************** *)
|
|
(* *)
|
|
(* DelphiCL *)
|
|
(* *)
|
|
(* created by : Maksym Tymkovych *)
|
|
(* (niello) *)
|
|
(* *)
|
|
(* headers versions: 0.07 *)
|
|
(* file name : DelphiCL.pas *)
|
|
(* last modify : 10.12.11 *)
|
|
(* license : BSD *)
|
|
(* *)
|
|
(* Site : www.niello.org.ua *)
|
|
(* e-mail : muxamed13@ukr.net *)
|
|
(* ICQ : 446-769-253 *)
|
|
(* *)
|
|
(* ********Copyright (c) niello 2008-2011**** *)
|
|
|
|
unit DelphiCL;
|
|
|
|
interface
|
|
|
|
uses
|
|
OpenCL,
|
|
Windows,
|
|
SysUtils;
|
|
|
|
type
|
|
|
|
TDCLMemFlags = (mfReadWrite, mfWriteOnly, mfReadOnly, mfUseHostPtr,
|
|
mfAllocHostPtr, mfCopyHostPtr);
|
|
TDCLMemFlagsSet = set of TDCLMemFlags;
|
|
|
|
TDCLBuffer = class
|
|
private
|
|
FMem: PCL_mem;
|
|
FStatus: CL_int;
|
|
FSize: Size_t;
|
|
protected
|
|
constructor Create(const Context: PCL_context; const Flags: TDCLMemFlagsSet;
|
|
const Size: Size_t; const Data: Pointer = nil);
|
|
public
|
|
procedure Free();
|
|
property Size: Size_t read FSize;
|
|
property Status: CL_int read FStatus;
|
|
end;
|
|
|
|
TDCLImage2D = class
|
|
private
|
|
FMem: PCL_mem;
|
|
FStatus: CL_int;
|
|
FFormat: CL_image_format;
|
|
FWidth: Size_t;
|
|
FHeight: Size_t;
|
|
FRowPitch: Size_t;
|
|
protected
|
|
constructor Create(const Context: PCL_context; const Flags: TDCLMemFlagsSet;
|
|
const Format: PCL_image_format; const Width, Height: Size_t;
|
|
const RowPitch: Size_t = 0; const Data: Pointer = nil);
|
|
public
|
|
procedure Free();
|
|
property Width: Size_t read FWidth;
|
|
property Height: Size_t read FHeight;
|
|
property RowPitch: Size_t read FRowPitch;
|
|
property Status: CL_int read FStatus;
|
|
end;
|
|
|
|
TDCLCommandQueueProperties = (cqpNone, cqpOutOfOrderExecModeEnable);
|
|
TDCLCommandQueuePropertiesSet = set of TDCLCommandQueueProperties;
|
|
|
|
TDCLKernel = class
|
|
private
|
|
FKernel: PCL_kernel;
|
|
FStatus: CL_int;
|
|
protected
|
|
constructor Create(const Program_: PCL_program; const KernelName: PPChar);
|
|
function GetFunctionName(): AnsiString;
|
|
function GetNumArgs(): CL_uint;
|
|
public
|
|
property Status: CL_int read FStatus;
|
|
property FunctionName: AnsiString read GetFunctionName;
|
|
property NumArgs: CL_uint read GetNumArgs;
|
|
procedure SetArg(const Index: CL_uint; const Size: Size_t;
|
|
const Value: Pointer); overload;
|
|
procedure SetArg(const Index: CL_uint; const Value: TDCLBuffer); overload;
|
|
procedure SetArg(const Index: CL_uint; const Value: TDCLImage2D); overload;
|
|
procedure Free();
|
|
end;
|
|
|
|
TDCLCommandQueue = class
|
|
private
|
|
FCommandQueue: PCL_command_queue;
|
|
FStatus: CL_int;
|
|
FProperties: TDCLCommandQueuePropertiesSet;
|
|
constructor Create(const Device_Id: PCL_device_id;
|
|
const Context: PCL_context;
|
|
const Properties: TDCLCommandQueuePropertiesSet = [cqpNone]);
|
|
public
|
|
procedure ReadBuffer(const Buffer: TDCLBuffer; const Size: Size_t;
|
|
const Data: Pointer);
|
|
procedure WriteBuffer(const Buffer: TDCLBuffer; const Size: Size_t;
|
|
const Data: Pointer);
|
|
procedure ReadImage2D(const Image: TDCLImage2D; const Width, Height: Size_t;
|
|
const Data: Pointer);
|
|
procedure WriteImage2D(const Image: TDCLImage2D;
|
|
const Width, Height: Size_t; const Data: Pointer);
|
|
procedure Execute(const Kernel: TDCLKernel; const Size: Size_t); overload;
|
|
procedure Execute(const Kernel: TDCLKernel; // const Device: PCL_device_id;
|
|
const Size: array of Size_t); overload;
|
|
property Status: CL_int read FStatus;
|
|
property Properties: TDCLCommandQueuePropertiesSet read FProperties;
|
|
procedure Free();
|
|
end;
|
|
|
|
TArraySize_t = Array of Size_t;
|
|
|
|
TDCLProgram = class
|
|
private
|
|
FProgram: PCL_program;
|
|
FStatus: CL_int;
|
|
FSource: PAnsiChar;
|
|
FBinarySizesCount: Size_t;
|
|
FBinarySizes: TArraySize_t;
|
|
// FBinaries: PByte;
|
|
protected
|
|
constructor Create(const Context: PCL_context; const Source: PPChar;
|
|
const Options: PPChar = nil);
|
|
function GetBinarySizes(const Index: Size_t): Size_t;
|
|
public
|
|
property BinarySizes[const Index: Size_t]: Size_t read GetBinarySizes;
|
|
property BinarySizesCount: Size_t read FBinarySizesCount;
|
|
property Source: PAnsiChar read FSource;
|
|
property Status: CL_int read FStatus;
|
|
function CreateKernel(const KernelName: PPChar): TDCLKernel;
|
|
procedure Free();
|
|
end;
|
|
|
|
TDCLContext = class
|
|
private
|
|
FContext: PCL_context;
|
|
FStatus: CL_int;
|
|
FNumDevices: CL_uint;
|
|
protected
|
|
// property Context: PCL_context read FContext;
|
|
public
|
|
constructor Create(Device_Id: PCL_device_id);
|
|
property Status: CL_int read FStatus;
|
|
property NumDevices: CL_uint read FNumDevices;
|
|
procedure Free();
|
|
end;
|
|
|
|
TDCLDevice = class
|
|
// private
|
|
FDevice_id: PCL_device_id;
|
|
private
|
|
FStatus: CL_int;
|
|
|
|
FName: AnsiString;
|
|
FVendor: AnsiString;
|
|
FVersion: AnsiString;
|
|
FProfile: AnsiString;
|
|
|
|
FIsCPU: Boolean;
|
|
FIsGPU: Boolean;
|
|
FIsAccelerator: Boolean;
|
|
FIsDefault: Boolean;
|
|
|
|
FMaxWorkGroupSize: Size_t;
|
|
|
|
FNativeVectorPreferredChar: CL_uint;
|
|
FNativeVectorPreferredShort: CL_uint;
|
|
FNativeVectorPreferredInt: CL_uint;
|
|
FNativeVectorPreferredLong: CL_uint;
|
|
FNativeVectorPreferredFloat: CL_uint;
|
|
FNativeVectorPreferredDouble: CL_uint;
|
|
FNativeVectorPreferredHalf: CL_uint;
|
|
FNativeVectorWidthChar: CL_uint;
|
|
FNativeVectorWidthShort: CL_uint;
|
|
FNativeVectorWidthInt: CL_uint;
|
|
FNativeVectorWidthLong: CL_uint;
|
|
FNativeVectorWidthFloat: CL_uint;
|
|
FNativeVectorWidthDouble: CL_uint;
|
|
FNativeVectorWidthHalf: CL_uint;
|
|
|
|
FMaxClockFrequency: CL_uint;
|
|
FAddressBits: CL_uint;
|
|
FMaxMemAllocSize: CL_ulong;
|
|
|
|
FIsImageSupport: Boolean;
|
|
|
|
FMaxReadImageArgs: CL_uint;
|
|
FMaxWriteImageArgs: CL_uint;
|
|
FImage2DMaxWidth: Size_t;
|
|
FImage2DMaxHeight: Size_t;
|
|
FImage3DMaxWidth: Size_t;
|
|
FImage3DMaxHeight: Size_t;
|
|
FImage3DMaxDepth: Size_t;
|
|
FMaxSamplers: CL_uint;
|
|
FMaxParameterSize: Size_t;
|
|
FMemBaseAddrAlign: CL_uint;
|
|
FMinDataTypeAlignSize: CL_uint;
|
|
|
|
FGlobalMemCacheLineSize: CL_uint;
|
|
FGlobalMemCacheSize: CL_ulong;
|
|
FGlobalMemSize: CL_ulong;
|
|
FMaxConstantBufferSize: CL_ulong;
|
|
FMaxConstantArgs: CL_uint;
|
|
|
|
FLocalMemSize: CL_ulong;
|
|
FIsErrorCorrectionSupport: Boolean;
|
|
FIsHostUnifiedMemory: Boolean;
|
|
FProfilingTimerResolution: Size_t;
|
|
FIsEndianLittle: Boolean;
|
|
FIsAvailable: Boolean;
|
|
FIsCompilerAvailable: Boolean;
|
|
|
|
FVendorId: CL_uint;
|
|
FMaxComputeUnits: CL_uint;
|
|
FMaxWorkItemDimensions: CL_uint;
|
|
FExtensionsString: AnsiString;
|
|
FOpenCLCVersion: AnsiString;
|
|
FDriverVersion: AnsiString;
|
|
|
|
FExtensionsCount: Size_t;
|
|
FExtensions: Array of AnsiString;
|
|
|
|
FContext: TDCLContext;
|
|
|
|
function GetExtensions(const Index: Size_t): AnsiString;
|
|
function IsPresentExtension(const ExtensionName: AnsiString): Boolean;
|
|
protected
|
|
constructor Create(Device_Id: PCL_device_id);
|
|
property Device_Id: PCL_device_id read FDevice_id;
|
|
public
|
|
property Status: CL_int read FStatus;
|
|
|
|
property Name: AnsiString read FName;
|
|
property Vendor: AnsiString read FVendor;
|
|
property Version: AnsiString read FVersion;
|
|
property Profile: AnsiString read FProfile;
|
|
|
|
property IsCPU: Boolean read FIsCPU;
|
|
property IsGPU: Boolean read FIsGPU;
|
|
property IsAccelerator: Boolean read FIsAccelerator;
|
|
property IsDefault: Boolean read FIsDefault;
|
|
|
|
property MaxWorkGroupSize: Size_t read FMaxWorkGroupSize;
|
|
|
|
property NativeVectorPreferredChar: CL_uint read FNativeVectorPreferredChar;
|
|
property NativeVectorPreferredShort: CL_uint
|
|
read FNativeVectorPreferredShort;
|
|
property NativeVectorPreferredInt: CL_uint read FNativeVectorPreferredInt;
|
|
property NativeVectorPreferredLong: CL_uint read FNativeVectorPreferredLong;
|
|
property NativeVectorPreferredFloat: CL_uint
|
|
read FNativeVectorPreferredFloat;
|
|
property NativeVectorPreferredDouble: CL_uint
|
|
read FNativeVectorPreferredDouble;
|
|
property NativeVectorPreferredHalf: CL_uint read FNativeVectorPreferredHalf;
|
|
property NativeVectorWidthChar: CL_uint read FNativeVectorWidthChar;
|
|
property NativeVectorWidthShort: CL_uint read FNativeVectorWidthShort;
|
|
property NativeVectorWidthInt: CL_uint read FNativeVectorWidthInt;
|
|
property NativeVectorWidthLong: CL_uint read FNativeVectorWidthLong;
|
|
property NativeVectorWidthFloat: CL_uint read FNativeVectorWidthFloat;
|
|
property NativeVectorWidthDouble: CL_uint read FNativeVectorWidthDouble;
|
|
property NativeVectorWidthHalf: CL_uint read FNativeVectorWidthHalf;
|
|
|
|
property MaxClockFrequency: CL_uint read FMaxClockFrequency;
|
|
property AddressBits: CL_uint read FAddressBits;
|
|
property MaxMemAllocSize: CL_ulong read FMaxMemAllocSize;
|
|
|
|
property IsImageSupport: Boolean read FIsImageSupport;
|
|
|
|
property MaxReadImageArgs: CL_uint read FMaxReadImageArgs;
|
|
property MaxWriteImageArgs: CL_uint read FMaxWriteImageArgs;
|
|
property Image2DMaxWidth: Size_t read FImage2DMaxWidth;
|
|
property Image2DMaxHeight: Size_t read FImage2DMaxHeight;
|
|
property Image3DMaxWidth: Size_t read FImage3DMaxWidth;
|
|
property Image3DMaxHeight: Size_t read FImage3DMaxHeight;
|
|
property Image3DMaxDepth: Size_t read FImage3DMaxDepth;
|
|
property MaxSamplers: CL_uint read FMaxSamplers;
|
|
property MaxParameterSize: Size_t read FMaxParameterSize;
|
|
property MemBaseAddrAlign: CL_uint read FMemBaseAddrAlign;
|
|
property MinDataTypeAlignSize: CL_uint read FMinDataTypeAlignSize;
|
|
|
|
property GlobalMemCacheLineSize: CL_uint read FGlobalMemCacheLineSize;
|
|
property GlobalMemCacheSize: CL_ulong read FGlobalMemCacheSize;
|
|
property GlobalMemSize: CL_ulong read FGlobalMemSize;
|
|
property MaxConstantBufferSize: CL_ulong read FMaxConstantBufferSize;
|
|
property MaxConstantArgs: CL_uint read FMaxConstantArgs;
|
|
|
|
property LocalMemSize: CL_ulong read FLocalMemSize;
|
|
property IsErrorCorrectionSupport: Boolean read FIsErrorCorrectionSupport;
|
|
property IsHostUnifiedMemory: Boolean read FIsHostUnifiedMemory;
|
|
property ProfilingTimerResolution: Size_t read FProfilingTimerResolution;
|
|
property IsEndianLittle: Boolean read FIsEndianLittle;
|
|
property IsAvailable: Boolean read FIsAvailable;
|
|
property IsCompilerAvailable: Boolean read FIsCompilerAvailable;
|
|
|
|
property VendorId: CL_uint read FVendorId;
|
|
property MaxComputeUnits: CL_uint read FMaxComputeUnits;
|
|
property MaxWorkItemDimensions: CL_uint read FMaxWorkItemDimensions;
|
|
|
|
property DriverVersion: AnsiString read FDriverVersion;
|
|
property OpenCLCVersion: AnsiString read FOpenCLCVersion;
|
|
property ExtensionsString: AnsiString read FExtensionsString;
|
|
|
|
property Context: TDCLContext read FContext;
|
|
function CreateContext(): TDCLContext;
|
|
function CreateCommandQueue(const Properties
|
|
: TDCLCommandQueuePropertiesSet = [cqpNone]): TDCLCommandQueue;
|
|
function CreateBuffer(const Size: Size_t; const Data: Pointer = nil;
|
|
const Flags: TDCLMemFlagsSet = [mfReadWrite]): TDCLBuffer;
|
|
function CreateImage2D(const Format: PCL_image_format;
|
|
const Width, Height, RowPitch: Size_t; const Data: Pointer = nil;
|
|
const Flags: TDCLMemFlagsSet = [mfReadWrite]): TDCLImage2D;
|
|
function CreateProgram(const Source: PPChar; const Options: PPChar = nil)
|
|
: TDCLProgram; overload;
|
|
function CreateProgram(const FileName: String; const Options: PPChar = nil)
|
|
: TDCLProgram; overload;
|
|
|
|
property ExtensionsCount: Size_t read FExtensionsCount;
|
|
property Extensions[const Index: Size_t]: AnsiString read GetExtensions;
|
|
property IsSupportedExtension[const Index: AnsiString]: Boolean
|
|
read IsPresentExtension;
|
|
procedure Free();
|
|
end;
|
|
|
|
TDCLPlatform = class
|
|
private
|
|
FPlatform_id: PCL_platform_id;
|
|
FProfile: AnsiString;
|
|
FVersion: AnsiString;
|
|
FName: AnsiString;
|
|
FVendor: AnsiString;
|
|
FExtensionsString: AnsiString;
|
|
FStatus: CL_int;
|
|
FDevices: Array of TDCLDevice;
|
|
FDeviceCount: CL_uint;
|
|
FExtensionsCount: Size_t;
|
|
FExtensions: Array of AnsiString;
|
|
function GetDevice(Index: CL_uint): TDCLDevice;
|
|
function GetExtensions(Index: Size_t): AnsiString;
|
|
function IsPresentExtension(const ExtensionName: AnsiString): Boolean;
|
|
|
|
function GetDeviceWithMaxClockFrequency(): TDCLDevice;
|
|
function GetDeviceWithMaxComputeUnits(): TDCLDevice;
|
|
|
|
function GetDeviceWithMaxGlobalMemCacheLineSize(): TDCLDevice;
|
|
function GetDeviceWithMaxGlobalMemCacheSize(): TDCLDevice;
|
|
function GetDeviceWithMaxGlobalMemSize(): TDCLDevice;
|
|
|
|
function GetDeviceWithMaxImage2DWidth(): TDCLDevice;
|
|
function GetDeviceWithMaxImage2DHeight(): TDCLDevice;
|
|
function GetDeviceWithMaxImage3DWidth(): TDCLDevice;
|
|
function GetDeviceWithMaxImage3DHeight(): TDCLDevice;
|
|
function GetDeviceWithMaxImage3DDepth(): TDCLDevice;
|
|
|
|
function GetDeviceWithMaxLocalMemSize(): TDCLDevice;
|
|
function GetDeviceWithMaxConstantArgs(): TDCLDevice;
|
|
function GetDeviceWithMaxConstantBufferSize(): TDCLDevice;
|
|
function GetDeviceWithMaxMemAllocSize(): TDCLDevice;
|
|
function GetDeviceWithMaxParameterSize(): TDCLDevice;
|
|
function GetDeviceWithMaxReadImageArgs(): TDCLDevice;
|
|
function GetDeviceWithMaxSamplers(): TDCLDevice;
|
|
function GetDeviceWithMaxWorkGroupSize(): TDCLDevice;
|
|
function GetDeviceWithMaxWorkItemDimensions(): TDCLDevice;
|
|
function GetDeviceWithMaxWriteImageArgs(): TDCLDevice;
|
|
public
|
|
constructor Create(Platform_id: PCL_platform_id);
|
|
property Profile: AnsiString read FProfile;
|
|
property Version: AnsiString read FVersion;
|
|
property Name: AnsiString read FName;
|
|
property Vendor: AnsiString read FVendor;
|
|
property ExtensionsString: AnsiString read FExtensionsString;
|
|
|
|
property DeviceCount: CL_uint read FDeviceCount;
|
|
property Status: CL_int read FStatus;
|
|
property Devices[Index: CL_uint]: TDCLDevice read GetDevice;
|
|
property ExtensionsCount: Size_t read FExtensionsCount;
|
|
property Extensions[Index: Size_t]: AnsiString read GetExtensions;
|
|
property IsSupportedExtension[const Index: AnsiString]: Boolean
|
|
read IsPresentExtension;
|
|
|
|
property DeviceWithMaxClockFrequency: TDCLDevice
|
|
read GetDeviceWithMaxClockFrequency;
|
|
property DeviceWithMaxComputeUnits: TDCLDevice
|
|
read GetDeviceWithMaxComputeUnits;
|
|
property DeviceWithMaxGlobalMemCacheLineSize: TDCLDevice
|
|
read GetDeviceWithMaxGlobalMemCacheLineSize;
|
|
property DeviceWithMaxGlobalMemCacheSize: TDCLDevice
|
|
read GetDeviceWithMaxGlobalMemCacheSize;
|
|
property DeviceWithMaxGlobalMemSize: TDCLDevice
|
|
read GetDeviceWithMaxGlobalMemSize;
|
|
property DeviceWithMaxImage2DWidth: TDCLDevice
|
|
read GetDeviceWithMaxImage2DWidth;
|
|
property DeviceWithMaxImage2DHeight: TDCLDevice
|
|
read GetDeviceWithMaxImage2DHeight;
|
|
property DeviceWithMaxImage3DWidth: TDCLDevice
|
|
read GetDeviceWithMaxImage3DWidth;
|
|
property DeviceWithMaxImage3DHeight: TDCLDevice
|
|
read GetDeviceWithMaxImage3DHeight;
|
|
property DeviceWithMaxImage3DDepth: TDCLDevice
|
|
read GetDeviceWithMaxImage3DDepth;
|
|
property DeviceWithMaxLocalMemSize: TDCLDevice
|
|
read GetDeviceWithMaxLocalMemSize;
|
|
property DeviceWithMaxConstantArgs: TDCLDevice
|
|
read GetDeviceWithMaxConstantArgs;
|
|
property DeviceWithMaxConstantBufferSize: TDCLDevice
|
|
read GetDeviceWithMaxConstantBufferSize;
|
|
property DeviceWithMaxMemAllocSize: TDCLDevice
|
|
read GetDeviceWithMaxMemAllocSize;
|
|
property DeviceWithMaxParameterSize: TDCLDevice
|
|
read GetDeviceWithMaxParameterSize;
|
|
property DeviceWithMaxReadImageArgs: TDCLDevice
|
|
read GetDeviceWithMaxReadImageArgs;
|
|
property DeviceWithMaxSamplers: TDCLDevice read GetDeviceWithMaxSamplers;
|
|
property DeviceWithMaxWorkGroupSize: TDCLDevice
|
|
read GetDeviceWithMaxWorkGroupSize;
|
|
property DeviceWithMaxWorkItemDimensions: TDCLDevice
|
|
read GetDeviceWithMaxWorkItemDimensions;
|
|
property DeviceWithMaxWriteImageArgs: TDCLDevice
|
|
read GetDeviceWithMaxWriteImageArgs;
|
|
procedure Free();
|
|
end;
|
|
|
|
TDCLPlatforms = class
|
|
private
|
|
FPlatforms: Array of TDCLPlatform;
|
|
FPlatformCount: CL_uint;
|
|
FStatus: CL_int;
|
|
function GetPlatform(Index: CL_uint): TDCLPlatform;
|
|
public
|
|
constructor Create();
|
|
property PlatformCount: CL_uint read FPlatformCount;
|
|
property Status: CL_int read FStatus;
|
|
property Platforms[Index: CL_uint]: TDCLPlatform read GetPlatform;
|
|
procedure Free();
|
|
end;
|
|
|
|
implementation
|
|
|
|
function UpperCase(const S: AnsiString): AnsiString;
|
|
var
|
|
Ch: AnsiChar;
|
|
L: Integer;
|
|
Source, Dest: PAnsiChar;
|
|
begin
|
|
L := Length(S);
|
|
SetLength(Result, L);
|
|
Source := Pointer(S);
|
|
Dest := Pointer(Result);
|
|
while L <> 0 do
|
|
begin
|
|
Ch := Source^;
|
|
if (Ch >= 'a') and (Ch <= 'z') then
|
|
Dec(Ch, 32);
|
|
Dest^ := Ch;
|
|
Inc(Source);
|
|
Inc(Dest);
|
|
Dec(L);
|
|
end;
|
|
end;
|
|
|
|
function IntToStr(Value: Integer): AnsiString;
|
|
begin
|
|
Str(Value, Result);
|
|
end;
|
|
|
|
{ TDCLPlatforms }
|
|
|
|
constructor TDCLPlatforms.Create;
|
|
var
|
|
Platforms: Array of PCL_platform_id;
|
|
i: Integer;
|
|
begin
|
|
FStatus := clGetPlatformIDs(0, nil, @FPlatformCount);
|
|
if FStatus = CL_SUCCESS then
|
|
begin
|
|
if FPlatformCount > 0 then
|
|
begin
|
|
SetLength(Platforms, FPlatformCount);
|
|
SetLength(FPlatforms, FPlatformCount);
|
|
FStatus := clGetPlatformIDs(FPlatformCount, @Platforms[0], nil);
|
|
for i := 0 to FPlatformCount - 1 do
|
|
begin
|
|
FPlatforms[i] := TDCLPlatform.Create(Platforms[i]);
|
|
end;
|
|
SetLength(Platforms, 0);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TDCLPlatforms.Free;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := 0 to FPlatformCount - 1 do
|
|
begin
|
|
FPlatforms[i].Free();
|
|
end;
|
|
SetLength(FPlatforms, 0);
|
|
inherited Free();
|
|
end;
|
|
|
|
function TDCLPlatforms.GetPlatform(Index: CL_uint): TDCLPlatform;
|
|
begin
|
|
if (Index < FPlatformCount) then
|
|
Result := FPlatforms[Index]
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
{ TDCLPlatform }
|
|
|
|
constructor TDCLPlatform.Create(Platform_id: PCL_platform_id);
|
|
var
|
|
Size: Size_t;
|
|
Devices: Array of PCL_device_id;
|
|
i, current, previous: Integer;
|
|
|
|
begin
|
|
inherited Create();
|
|
FPlatform_id := Platform_id;
|
|
FStatus := clGetPlatformInfo(FPlatform_id, CL_PLATFORM_PROFILE, 0, nil, Size);
|
|
SetLength(FProfile, Size);
|
|
FStatus := clGetPlatformInfo(FPlatform_id, CL_PLATFORM_PROFILE, Size,
|
|
@FProfile[1], Size);
|
|
// FProfile := Buffer;
|
|
|
|
FStatus := clGetPlatformInfo(FPlatform_id, CL_PLATFORM_VERSION, 0, nil, Size);
|
|
SetLength(FVersion, Size);
|
|
FStatus := clGetPlatformInfo(FPlatform_id, CL_PLATFORM_VERSION, Size,
|
|
@FVersion[1], Size);
|
|
SetLength(FName, Size);
|
|
FStatus := clGetPlatformInfo(FPlatform_id, CL_PLATFORM_NAME, Size,
|
|
@FName[1], Size);
|
|
SetLength(FVendor, Size);
|
|
FStatus := clGetPlatformInfo(FPlatform_id, CL_PLATFORM_VENDOR, Size,
|
|
@FVendor[1], Size);
|
|
SetLength(FExtensionsString, Size);
|
|
FStatus := clGetPlatformInfo(FPlatform_id, CL_PLATFORM_EXTENSIONS, Size,
|
|
@FExtensionsString[1], Size);
|
|
FExtensionsCount := 0;
|
|
i := 1;
|
|
while (i <= Length(FExtensionsString)) do
|
|
begin
|
|
if ((FExtensionsString[i] = ' ') or (FExtensionsString[i] = #0)) then
|
|
Inc(FExtensionsCount);
|
|
Inc(i);
|
|
end;
|
|
SetLength(FExtensions, FExtensionsCount);
|
|
previous := 1;
|
|
current := 1;
|
|
i := 0;
|
|
while (current <= Length(FExtensionsString)) do
|
|
begin
|
|
if ((FExtensionsString[current] = ' ') or (FExtensionsString[current] = #0))
|
|
then
|
|
begin
|
|
FExtensions[i] := UpperCase(Copy(FExtensionsString, previous,
|
|
current - previous - 1));
|
|
previous := current + 1;
|
|
Inc(i);
|
|
end;
|
|
Inc(current);
|
|
end;
|
|
|
|
FStatus := clGetDeviceIDs(FPlatform_id, CL_DEVICE_TYPE_ALL, 0, nil,
|
|
@FDeviceCount);
|
|
if FDeviceCount > 0 then
|
|
begin
|
|
SetLength(Devices, FDeviceCount);
|
|
FStatus := clGetDeviceIDs(FPlatform_id, CL_DEVICE_TYPE_ALL, FDeviceCount,
|
|
@Devices[0], nil);
|
|
SetLength(FDevices, FDeviceCount);
|
|
for i := 0 to FDeviceCount - 1 do
|
|
begin
|
|
FDevices[i] := TDCLDevice.Create(Devices[i]);
|
|
end;
|
|
end;
|
|
|
|
end;
|
|
|
|
procedure TDCLPlatform.Free;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
SetLength(FExtensions, 0);
|
|
FExtensionsString := '';
|
|
for i := 0 to FDeviceCount - 1 do
|
|
begin
|
|
FDevices[i].Free();
|
|
end;
|
|
SetLength(FDevices, 0);
|
|
inherited Free();
|
|
end;
|
|
|
|
function TDCLPlatform.GetDevice(Index: CL_uint): TDCLDevice;
|
|
begin
|
|
if (Index < FDeviceCount) then
|
|
Result := FDevices[Index]
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
function TDCLPlatform.GetDeviceWithMaxClockFrequency: TDCLDevice;
|
|
function GetParameterDevice(const Device: TDCLDevice): CL_uint;
|
|
begin
|
|
Result := Device.MaxClockFrequency;
|
|
end;
|
|
|
|
var
|
|
i: Integer;
|
|
MaxValue: CL_uint;
|
|
MaxValuePos: CL_uint;
|
|
begin
|
|
if FDeviceCount = 0 then
|
|
begin
|
|
Result := nil;
|
|
Exit;
|
|
end;
|
|
MaxValue := GetParameterDevice(FDevices[0]);
|
|
MaxValuePos := 0;
|
|
for i := 1 to FDeviceCount - 1 do
|
|
begin
|
|
if GetParameterDevice(FDevices[i]) > MaxValue then
|
|
begin
|
|
MaxValue := GetParameterDevice(FDevices[i]);
|
|
MaxValuePos := i;
|
|
end;
|
|
end;
|
|
Result := FDevices[MaxValuePos];
|
|
end;
|
|
|
|
function TDCLPlatform.GetDeviceWithMaxComputeUnits: TDCLDevice;
|
|
function GetParameterDevice(const Device: TDCLDevice): CL_uint;
|
|
begin
|
|
Result := Device.MaxComputeUnits;
|
|
end;
|
|
|
|
var
|
|
i: Integer;
|
|
MaxValue: CL_uint;
|
|
MaxValuePos: CL_uint;
|
|
begin
|
|
if FDeviceCount = 0 then
|
|
begin
|
|
Result := nil;
|
|
Exit;
|
|
end;
|
|
MaxValue := GetParameterDevice(FDevices[0]);
|
|
MaxValuePos := 0;
|
|
for i := 1 to FDeviceCount - 1 do
|
|
begin
|
|
if GetParameterDevice(FDevices[i]) > MaxValue then
|
|
begin
|
|
MaxValue := GetParameterDevice(FDevices[i]);
|
|
MaxValuePos := i;
|
|
end;
|
|
end;
|
|
Result := FDevices[MaxValuePos];
|
|
end;
|
|
|
|
function TDCLPlatform.GetDeviceWithMaxConstantArgs: TDCLDevice;
|
|
function GetParameterDevice(const Device: TDCLDevice): CL_uint;
|
|
begin
|
|
Result := Device.MaxConstantArgs;
|
|
end;
|
|
|
|
var
|
|
i: Integer;
|
|
MaxValue: CL_uint;
|
|
MaxValuePos: CL_uint;
|
|
begin
|
|
if FDeviceCount = 0 then
|
|
begin
|
|
Result := nil;
|
|
Exit;
|
|
end;
|
|
MaxValue := GetParameterDevice(FDevices[0]);
|
|
MaxValuePos := 0;
|
|
for i := 1 to FDeviceCount - 1 do
|
|
begin
|
|
if GetParameterDevice(FDevices[i]) > MaxValue then
|
|
begin
|
|
MaxValue := GetParameterDevice(FDevices[i]);
|
|
MaxValuePos := i;
|
|
end;
|
|
end;
|
|
Result := FDevices[MaxValuePos];
|
|
end;
|
|
|
|
function TDCLPlatform.GetDeviceWithMaxConstantBufferSize: TDCLDevice;
|
|
function GetParameterDevice(const Device: TDCLDevice): CL_ulong;
|
|
begin
|
|
Result := Device.MaxConstantBufferSize;
|
|
end;
|
|
|
|
var
|
|
i: Integer;
|
|
MaxValue: CL_ulong;
|
|
MaxValuePos: CL_uint;
|
|
begin
|
|
if FDeviceCount = 0 then
|
|
begin
|
|
Result := nil;
|
|
Exit;
|
|
end;
|
|
MaxValue := GetParameterDevice(FDevices[0]);
|
|
MaxValuePos := 0;
|
|
for i := 1 to FDeviceCount - 1 do
|
|
begin
|
|
if GetParameterDevice(FDevices[i]) > MaxValue then
|
|
begin
|
|
MaxValue := GetParameterDevice(FDevices[i]);
|
|
MaxValuePos := i;
|
|
end;
|
|
end;
|
|
Result := FDevices[MaxValuePos];
|
|
end;
|
|
|
|
function TDCLPlatform.GetDeviceWithMaxGlobalMemCacheLineSize: TDCLDevice;
|
|
function GetParameterDevice(const Device: TDCLDevice): CL_uint;
|
|
begin
|
|
Result := Device.GlobalMemCacheLineSize;
|
|
end;
|
|
|
|
var
|
|
i: Integer;
|
|
MaxValue: CL_uint;
|
|
MaxValuePos: CL_uint;
|
|
begin
|
|
if FDeviceCount = 0 then
|
|
begin
|
|
Result := nil;
|
|
Exit;
|
|
end;
|
|
MaxValue := GetParameterDevice(FDevices[0]);
|
|
MaxValuePos := 0;
|
|
for i := 1 to FDeviceCount - 1 do
|
|
begin
|
|
if GetParameterDevice(FDevices[i]) > MaxValue then
|
|
begin
|
|
MaxValue := GetParameterDevice(FDevices[i]);
|
|
MaxValuePos := i;
|
|
end;
|
|
end;
|
|
Result := FDevices[MaxValuePos];
|
|
end;
|
|
|
|
function TDCLPlatform.GetDeviceWithMaxGlobalMemCacheSize: TDCLDevice;
|
|
function GetParameterDevice(const Device: TDCLDevice): CL_ulong;
|
|
begin
|
|
Result := Device.GlobalMemCacheSize;
|
|
end;
|
|
|
|
var
|
|
i: Integer;
|
|
MaxValue: CL_ulong;
|
|
MaxValuePos: CL_uint;
|
|
begin
|
|
if FDeviceCount = 0 then
|
|
begin
|
|
Result := nil;
|
|
Exit;
|
|
end;
|
|
MaxValue := GetParameterDevice(FDevices[0]);
|
|
MaxValuePos := 0;
|
|
for i := 1 to FDeviceCount - 1 do
|
|
begin
|
|
if GetParameterDevice(FDevices[i]) > MaxValue then
|
|
begin
|
|
MaxValue := GetParameterDevice(FDevices[i]);
|
|
MaxValuePos := i;
|
|
end;
|
|
end;
|
|
Result := FDevices[MaxValuePos];
|
|
end;
|
|
|
|
function TDCLPlatform.GetDeviceWithMaxGlobalMemSize: TDCLDevice;
|
|
function GetParameterDevice(const Device: TDCLDevice): CL_ulong;
|
|
begin
|
|
Result := Device.GlobalMemSize;
|
|
end;
|
|
|
|
var
|
|
i: Integer;
|
|
MaxValue: CL_ulong;
|
|
MaxValuePos: CL_uint;
|
|
begin
|
|
if FDeviceCount = 0 then
|
|
begin
|
|
Result := nil;
|
|
Exit;
|
|
end;
|
|
MaxValue := GetParameterDevice(FDevices[0]);
|
|
MaxValuePos := 0;
|
|
for i := 1 to FDeviceCount - 1 do
|
|
begin
|
|
if GetParameterDevice(FDevices[i]) > MaxValue then
|
|
begin
|
|
MaxValue := GetParameterDevice(FDevices[i]);
|
|
MaxValuePos := i;
|
|
end;
|
|
end;
|
|
Result := FDevices[MaxValuePos];
|
|
end;
|
|
|
|
function TDCLPlatform.GetDeviceWithMaxImage2DHeight: TDCLDevice;
|
|
function GetParameterDevice(const Device: TDCLDevice): Size_t;
|
|
begin
|
|
Result := Device.Image2DMaxHeight;
|
|
end;
|
|
|
|
var
|
|
i: Integer;
|
|
MaxValue: Size_t;
|
|
MaxValuePos: CL_uint;
|
|
begin
|
|
if FDeviceCount = 0 then
|
|
begin
|
|
Result := nil;
|
|
Exit;
|
|
end;
|
|
MaxValue := GetParameterDevice(FDevices[0]);
|
|
MaxValuePos := 0;
|
|
for i := 1 to FDeviceCount - 1 do
|
|
begin
|
|
if GetParameterDevice(FDevices[i]) > MaxValue then
|
|
begin
|
|
MaxValue := GetParameterDevice(FDevices[i]);
|
|
MaxValuePos := i;
|
|
end;
|
|
end;
|
|
Result := FDevices[MaxValuePos];
|
|
end;
|
|
|
|
function TDCLPlatform.GetDeviceWithMaxImage2DWidth: TDCLDevice;
|
|
function GetParameterDevice(const Device: TDCLDevice): Size_t;
|
|
begin
|
|
Result := Device.Image2DMaxWidth;
|
|
end;
|
|
|
|
var
|
|
i: Integer;
|
|
MaxValue: Size_t;
|
|
MaxValuePos: CL_uint;
|
|
begin
|
|
if FDeviceCount = 0 then
|
|
begin
|
|
Result := nil;
|
|
Exit;
|
|
end;
|
|
MaxValue := GetParameterDevice(FDevices[0]);
|
|
MaxValuePos := 0;
|
|
for i := 1 to FDeviceCount - 1 do
|
|
begin
|
|
if GetParameterDevice(FDevices[i]) > MaxValue then
|
|
begin
|
|
MaxValue := GetParameterDevice(FDevices[i]);
|
|
MaxValuePos := i;
|
|
end;
|
|
end;
|
|
Result := FDevices[MaxValuePos];
|
|
end;
|
|
|
|
function TDCLPlatform.GetDeviceWithMaxImage3DDepth: TDCLDevice;
|
|
function GetParameterDevice(const Device: TDCLDevice): Size_t;
|
|
begin
|
|
Result := Device.Image3DMaxDepth;
|
|
end;
|
|
|
|
var
|
|
i: Integer;
|
|
MaxValue: Size_t;
|
|
MaxValuePos: CL_uint;
|
|
begin
|
|
if FDeviceCount = 0 then
|
|
begin
|
|
Result := nil;
|
|
Exit;
|
|
end;
|
|
MaxValue := GetParameterDevice(FDevices[0]);
|
|
MaxValuePos := 0;
|
|
for i := 1 to FDeviceCount - 1 do
|
|
begin
|
|
if GetParameterDevice(FDevices[i]) > MaxValue then
|
|
begin
|
|
MaxValue := GetParameterDevice(FDevices[i]);
|
|
MaxValuePos := i;
|
|
end;
|
|
end;
|
|
Result := FDevices[MaxValuePos];
|
|
end;
|
|
|
|
function TDCLPlatform.GetDeviceWithMaxImage3DHeight: TDCLDevice;
|
|
function GetParameterDevice(const Device: TDCLDevice): Size_t;
|
|
begin
|
|
Result := Device.Image3DMaxHeight;
|
|
end;
|
|
|
|
var
|
|
i: Integer;
|
|
MaxValue: Size_t;
|
|
MaxValuePos: CL_uint;
|
|
begin
|
|
if FDeviceCount = 0 then
|
|
begin
|
|
Result := nil;
|
|
Exit;
|
|
end;
|
|
MaxValue := GetParameterDevice(FDevices[0]);
|
|
MaxValuePos := 0;
|
|
for i := 1 to FDeviceCount - 1 do
|
|
begin
|
|
if GetParameterDevice(FDevices[i]) > MaxValue then
|
|
begin
|
|
MaxValue := GetParameterDevice(FDevices[i]);
|
|
MaxValuePos := i;
|
|
end;
|
|
end;
|
|
Result := FDevices[MaxValuePos];
|
|
end;
|
|
|
|
function TDCLPlatform.GetDeviceWithMaxImage3DWidth: TDCLDevice;
|
|
function GetParameterDevice(const Device: TDCLDevice): Size_t;
|
|
begin
|
|
Result := Device.Image3DMaxWidth;
|
|
end;
|
|
|
|
var
|
|
i: Integer;
|
|
MaxValue: Size_t;
|
|
MaxValuePos: CL_uint;
|
|
begin
|
|
if FDeviceCount = 0 then
|
|
begin
|
|
Result := nil;
|
|
Exit;
|
|
end;
|
|
MaxValue := GetParameterDevice(FDevices[0]);
|
|
MaxValuePos := 0;
|
|
for i := 1 to FDeviceCount - 1 do
|
|
begin
|
|
if GetParameterDevice(FDevices[i]) > MaxValue then
|
|
begin
|
|
MaxValue := GetParameterDevice(FDevices[i]);
|
|
MaxValuePos := i;
|
|
end;
|
|
end;
|
|
Result := FDevices[MaxValuePos];
|
|
end;
|
|
|
|
function TDCLPlatform.GetDeviceWithMaxLocalMemSize: TDCLDevice;
|
|
function GetParameterDevice(const Device: TDCLDevice): CL_ulong;
|
|
begin
|
|
Result := Device.LocalMemSize;
|
|
end;
|
|
|
|
var
|
|
i: Integer;
|
|
MaxValue: CL_ulong;
|
|
MaxValuePos: CL_uint;
|
|
begin
|
|
if FDeviceCount = 0 then
|
|
begin
|
|
Result := nil;
|
|
Exit;
|
|
end;
|
|
MaxValue := GetParameterDevice(FDevices[0]);
|
|
MaxValuePos := 0;
|
|
for i := 1 to FDeviceCount - 1 do
|
|
begin
|
|
if GetParameterDevice(FDevices[i]) > MaxValue then
|
|
begin
|
|
MaxValue := GetParameterDevice(FDevices[i]);
|
|
MaxValuePos := i;
|
|
end;
|
|
end;
|
|
Result := FDevices[MaxValuePos];
|
|
end;
|
|
|
|
function TDCLPlatform.GetDeviceWithMaxMemAllocSize: TDCLDevice;
|
|
function GetParameterDevice(const Device: TDCLDevice): CL_ulong;
|
|
begin
|
|
Result := Device.MaxMemAllocSize;
|
|
end;
|
|
|
|
var
|
|
i: Integer;
|
|
MaxValue: CL_ulong;
|
|
MaxValuePos: CL_uint;
|
|
begin
|
|
if FDeviceCount = 0 then
|
|
begin
|
|
Result := nil;
|
|
Exit;
|
|
end;
|
|
MaxValue := GetParameterDevice(FDevices[0]);
|
|
MaxValuePos := 0;
|
|
for i := 1 to FDeviceCount - 1 do
|
|
begin
|
|
if GetParameterDevice(FDevices[i]) > MaxValue then
|
|
begin
|
|
MaxValue := GetParameterDevice(FDevices[i]);
|
|
MaxValuePos := i;
|
|
end;
|
|
end;
|
|
Result := FDevices[MaxValuePos];
|
|
end;
|
|
|
|
function TDCLPlatform.GetDeviceWithMaxParameterSize: TDCLDevice;
|
|
function GetParameterDevice(const Device: TDCLDevice): Size_t;
|
|
begin
|
|
Result := Device.MaxParameterSize;
|
|
end;
|
|
|
|
var
|
|
i: Integer;
|
|
MaxValue: Size_t;
|
|
MaxValuePos: CL_uint;
|
|
begin
|
|
if FDeviceCount = 0 then
|
|
begin
|
|
Result := nil;
|
|
Exit;
|
|
end;
|
|
MaxValue := GetParameterDevice(FDevices[0]);
|
|
MaxValuePos := 0;
|
|
for i := 1 to FDeviceCount - 1 do
|
|
begin
|
|
if GetParameterDevice(FDevices[i]) > MaxValue then
|
|
begin
|
|
MaxValue := GetParameterDevice(FDevices[i]);
|
|
MaxValuePos := i;
|
|
end;
|
|
end;
|
|
Result := FDevices[MaxValuePos];
|
|
end;
|
|
|
|
function TDCLPlatform.GetDeviceWithMaxReadImageArgs: TDCLDevice;
|
|
function GetParameterDevice(const Device: TDCLDevice): CL_uint;
|
|
begin
|
|
Result := Device.MaxReadImageArgs;
|
|
end;
|
|
|
|
var
|
|
i: Integer;
|
|
MaxValue: CL_uint;
|
|
MaxValuePos: CL_uint;
|
|
begin
|
|
if FDeviceCount = 0 then
|
|
begin
|
|
Result := nil;
|
|
Exit;
|
|
end;
|
|
MaxValue := GetParameterDevice(FDevices[0]);
|
|
MaxValuePos := 0;
|
|
for i := 1 to FDeviceCount - 1 do
|
|
begin
|
|
if GetParameterDevice(FDevices[i]) > MaxValue then
|
|
begin
|
|
MaxValue := GetParameterDevice(FDevices[i]);
|
|
MaxValuePos := i;
|
|
end;
|
|
end;
|
|
Result := FDevices[MaxValuePos];
|
|
end;
|
|
|
|
function TDCLPlatform.GetDeviceWithMaxSamplers: TDCLDevice;
|
|
function GetParameterDevice(const Device: TDCLDevice): CL_uint;
|
|
begin
|
|
Result := Device.MaxSamplers;
|
|
end;
|
|
|
|
var
|
|
i: Integer;
|
|
MaxValue: CL_uint;
|
|
MaxValuePos: CL_uint;
|
|
begin
|
|
if FDeviceCount = 0 then
|
|
begin
|
|
Result := nil;
|
|
Exit;
|
|
end;
|
|
MaxValue := GetParameterDevice(FDevices[0]);
|
|
MaxValuePos := 0;
|
|
for i := 1 to FDeviceCount - 1 do
|
|
begin
|
|
if GetParameterDevice(FDevices[i]) > MaxValue then
|
|
begin
|
|
MaxValue := GetParameterDevice(FDevices[i]);
|
|
MaxValuePos := i;
|
|
end;
|
|
end;
|
|
Result := FDevices[MaxValuePos];
|
|
end;
|
|
|
|
function TDCLPlatform.GetDeviceWithMaxWorkGroupSize: TDCLDevice;
|
|
function GetParameterDevice(const Device: TDCLDevice): Size_t;
|
|
begin
|
|
Result := Device.MaxWorkGroupSize;
|
|
end;
|
|
|
|
var
|
|
i: Integer;
|
|
MaxValue: Size_t;
|
|
MaxValuePos: CL_uint;
|
|
begin
|
|
if FDeviceCount = 0 then
|
|
begin
|
|
Result := nil;
|
|
Exit;
|
|
end;
|
|
MaxValue := GetParameterDevice(FDevices[0]);
|
|
MaxValuePos := 0;
|
|
for i := 1 to FDeviceCount - 1 do
|
|
begin
|
|
if GetParameterDevice(FDevices[i]) > MaxValue then
|
|
begin
|
|
MaxValue := GetParameterDevice(FDevices[i]);
|
|
MaxValuePos := i;
|
|
end;
|
|
end;
|
|
Result := FDevices[MaxValuePos];
|
|
end;
|
|
|
|
function TDCLPlatform.GetDeviceWithMaxWorkItemDimensions: TDCLDevice;
|
|
function GetParameterDevice(const Device: TDCLDevice): CL_uint;
|
|
begin
|
|
Result := Device.MaxWorkItemDimensions;
|
|
end;
|
|
|
|
var
|
|
i: Integer;
|
|
MaxValue: CL_uint;
|
|
MaxValuePos: CL_uint;
|
|
begin
|
|
if FDeviceCount = 0 then
|
|
begin
|
|
Result := nil;
|
|
Exit;
|
|
end;
|
|
MaxValue := GetParameterDevice(FDevices[0]);
|
|
MaxValuePos := 0;
|
|
for i := 1 to FDeviceCount - 1 do
|
|
begin
|
|
if GetParameterDevice(FDevices[i]) > MaxValue then
|
|
begin
|
|
MaxValue := GetParameterDevice(FDevices[i]);
|
|
MaxValuePos := i;
|
|
end;
|
|
end;
|
|
Result := FDevices[MaxValuePos];
|
|
end;
|
|
|
|
function TDCLPlatform.GetDeviceWithMaxWriteImageArgs: TDCLDevice;
|
|
function GetParameterDevice(const Device: TDCLDevice): CL_uint;
|
|
begin
|
|
Result := Device.MaxWriteImageArgs;
|
|
end;
|
|
|
|
var
|
|
i: Integer;
|
|
MaxValue: CL_uint;
|
|
MaxValuePos: CL_uint;
|
|
begin
|
|
if FDeviceCount = 0 then
|
|
begin
|
|
Result := nil;
|
|
Exit;
|
|
end;
|
|
MaxValue := GetParameterDevice(FDevices[0]);
|
|
MaxValuePos := 0;
|
|
for i := 1 to FDeviceCount - 1 do
|
|
begin
|
|
if GetParameterDevice(FDevices[i]) > MaxValue then
|
|
begin
|
|
MaxValue := GetParameterDevice(FDevices[i]);
|
|
MaxValuePos := i;
|
|
end;
|
|
end;
|
|
Result := FDevices[MaxValuePos];
|
|
end;
|
|
|
|
function TDCLPlatform.GetExtensions(Index: Size_t): AnsiString;
|
|
begin
|
|
if Index < FExtensionsCount then
|
|
Result := FExtensions[Index]
|
|
else
|
|
Result := '';
|
|
end;
|
|
|
|
function TDCLPlatform.IsPresentExtension(const ExtensionName
|
|
: AnsiString): Boolean;
|
|
var
|
|
i: Integer;
|
|
UppName: AnsiString;
|
|
begin
|
|
Result := False;
|
|
UppName := UpperCase(ExtensionName);
|
|
for i := 0 to High(FExtensions) do
|
|
begin
|
|
if FExtensions[i] = UppName then
|
|
begin
|
|
Result := True;
|
|
Break;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{ TDCLDevice }
|
|
|
|
constructor TDCLDevice.Create(Device_Id: PCL_device_id);
|
|
(*
|
|
need to add
|
|
CL_DEVICE_TYPE
|
|
CL_DEVICE_MAX_WORK_ITEM_SIZES
|
|
CL_DEVICE_SINGLE_FP_CONFIG
|
|
CL_DEVICE_GLOBAL_MEM_CACHE_TYPE
|
|
CL_DEVICE_GLOBAL_MEM_CACHE_TYPE
|
|
CL_DEVICE_EXECUTION_CAPABILITIES
|
|
CL_DEVICE_QUEUE_PROPERTIES
|
|
*)
|
|
|
|
var
|
|
Size: Size_t;
|
|
device_type: CL_device_type;
|
|
b_bool: CL_bool;
|
|
|
|
i, current, previous: Integer;
|
|
begin
|
|
inherited Create();
|
|
FDevice_id := Device_Id;
|
|
|
|
FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_NAME, 0, nil, Size);
|
|
SetLength(FName, Size);
|
|
FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_NAME, Size, @FName[1], Size);
|
|
FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_VENDOR, 0, nil, Size);
|
|
SetLength(FVendor, Size);
|
|
FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_VENDOR, Size,
|
|
@FVendor[1], Size);
|
|
FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_VERSION, 0, nil, Size);
|
|
SetLength(FVersion, Size);
|
|
FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_VERSION, Size,
|
|
@FVersion[1], Size);
|
|
FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_PROFILE, 0, nil, Size);
|
|
SetLength(FProfile, Size);
|
|
FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_PROFILE, Size,
|
|
@FProfile[1], Size);
|
|
FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_TYPE_INFO,
|
|
SizeOf(device_type), @device_type, Size);
|
|
if (device_type and CL_DEVICE_TYPE_CPU) <> 0 then
|
|
FIsCPU := True;
|
|
if (device_type and CL_DEVICE_TYPE_GPU) <> 0 then
|
|
FIsGPU := True;
|
|
if (device_type and CL_DEVICE_TYPE_ACCELERATOR) <> 0 then
|
|
FIsAccelerator := True;
|
|
if (device_type and CL_DEVICE_TYPE_DEFAULT) <> 0 then
|
|
FIsDefault := True;
|
|
|
|
FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_PREFERRED_VECTOR_WIDTH_CHAR,
|
|
SizeOf(FMaxWorkGroupSize), @FMaxWorkGroupSize, Size);
|
|
FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_PREFERRED_VECTOR_WIDTH_CHAR,
|
|
SizeOf(FNativeVectorPreferredChar), @FNativeVectorPreferredChar, Size);
|
|
FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_PREFERRED_VECTOR_WIDTH_SHORT,
|
|
SizeOf(FNativeVectorPreferredShort), @FNativeVectorPreferredShort, Size);
|
|
FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_PREFERRED_VECTOR_WIDTH_INT,
|
|
SizeOf(FNativeVectorPreferredInt), @FNativeVectorPreferredInt, Size);
|
|
FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_PREFERRED_VECTOR_WIDTH_LONG,
|
|
SizeOf(FNativeVectorPreferredLong), @FNativeVectorPreferredLong, Size);
|
|
FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_PREFERRED_VECTOR_WIDTH_FLOAT,
|
|
SizeOf(FNativeVectorPreferredFloat), @FNativeVectorPreferredFloat, Size);
|
|
FStatus := clGetDeviceInfo(FDevice_id,
|
|
CL_DEVICE_PREFERRED_VECTOR_WIDTH_DOUBLE,
|
|
SizeOf(FNativeVectorPreferredDouble), @FNativeVectorPreferredDouble, Size);
|
|
FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_PREFERRED_VECTOR_WIDTH_HALF,
|
|
SizeOf(FNativeVectorPreferredHalf), @FNativeVectorPreferredHalf, Size);
|
|
FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_NATIVE_VECTOR_WIDTH_CHAR,
|
|
SizeOf(FNativeVectorWidthChar), @FNativeVectorWidthChar, Size);
|
|
FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_NATIVE_VECTOR_WIDTH_SHORT,
|
|
SizeOf(FNativeVectorWidthShort), @FNativeVectorWidthShort, Size);
|
|
FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_NATIVE_VECTOR_WIDTH_INT,
|
|
SizeOf(FNativeVectorWidthInt), @FNativeVectorWidthInt, Size);
|
|
FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_NATIVE_VECTOR_WIDTH_LONG,
|
|
SizeOf(FNativeVectorWidthLong), @FNativeVectorWidthLong, Size);
|
|
FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_NATIVE_VECTOR_WIDTH_FLOAT,
|
|
SizeOf(FNativeVectorWidthFloat), @FNativeVectorWidthFloat, Size);
|
|
FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_NATIVE_VECTOR_WIDTH_DOUBLE,
|
|
SizeOf(FNativeVectorWidthDouble), @FNativeVectorWidthDouble, Size);
|
|
FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_NATIVE_VECTOR_WIDTH_HALF,
|
|
SizeOf(FNativeVectorWidthHalf), @FNativeVectorWidthHalf, Size);
|
|
FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_MAX_CLOCK_FREQUENCY,
|
|
SizeOf(FMaxClockFrequency), @FMaxClockFrequency, Size);
|
|
FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_ADDRESS_BITS,
|
|
SizeOf(FAddressBits), @FAddressBits, Size);
|
|
FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_MAX_MEM_ALLOC_SIZE,
|
|
SizeOf(FMaxMemAllocSize), @FMaxMemAllocSize, Size);
|
|
FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_IMAGE_SUPPORT,
|
|
SizeOf(b_bool), @b_bool, Size);
|
|
if b_bool <> 0 then
|
|
FIsImageSupport := True;
|
|
|
|
FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_MAX_READ_IMAGE_ARGS,
|
|
SizeOf(FMaxReadImageArgs), @FMaxReadImageArgs, Size);
|
|
FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_MAX_WRITE_IMAGE_ARGS,
|
|
SizeOf(FMaxWriteImageArgs), @FMaxWriteImageArgs, Size);
|
|
FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_IMAGE2D_MAX_WIDTH,
|
|
SizeOf(FImage2DMaxWidth), @FImage2DMaxWidth, Size);
|
|
FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_IMAGE2D_MAX_HEIGHT,
|
|
SizeOf(FImage2DMaxHeight), @FImage2DMaxHeight, Size);
|
|
FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_IMAGE3D_MAX_WIDTH,
|
|
SizeOf(FImage3DMaxWidth), @FImage3DMaxWidth, Size);
|
|
FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_IMAGE3D_MAX_HEIGHT,
|
|
SizeOf(FImage3DMaxHeight), @FImage3DMaxHeight, Size);
|
|
FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_IMAGE3D_MAX_DEPTH,
|
|
SizeOf(FImage3DMaxDepth), @FImage3DMaxDepth, Size);
|
|
FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_MAX_SAMPLERS,
|
|
SizeOf(FMaxSamplers), @FMaxSamplers, Size);
|
|
FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_MAX_PARAMETER_SIZE,
|
|
SizeOf(FMaxParameterSize), @FMaxParameterSize, Size);
|
|
FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_MEM_BASE_ADDR_ALIGN,
|
|
SizeOf(FMemBaseAddrAlign), @FMemBaseAddrAlign, Size);
|
|
FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_MIN_DATA_TYPE_ALIGN_SIZE,
|
|
SizeOf(FMinDataTypeAlignSize), @FMinDataTypeAlignSize, Size);
|
|
FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_GLOBAL_MEM_CACHELINE_SIZE,
|
|
SizeOf(FGlobalMemCacheLineSize), @FGlobalMemCacheLineSize, Size);
|
|
FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_GLOBAL_MEM_CACHE_SIZE,
|
|
SizeOf(FGlobalMemCacheSize), @FGlobalMemCacheSize, Size);
|
|
FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_GLOBAL_MEM_SIZE,
|
|
SizeOf(FGlobalMemSize), @FGlobalMemSize, Size);
|
|
FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_MAX_CONSTANT_BUFFER_SIZE,
|
|
SizeOf(FMaxConstantBufferSize), @FMaxConstantBufferSize, Size);
|
|
FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_MAX_CONSTANT_ARGS,
|
|
SizeOf(FMaxConstantArgs), @FMaxConstantArgs, Size);
|
|
FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_LOCAL_MEM_SIZE,
|
|
SizeOf(FLocalMemSize), @FLocalMemSize, Size);
|
|
FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_ENDIAN_LITTLE,
|
|
SizeOf(b_bool), @b_bool, Size);
|
|
if b_bool <> 0 then
|
|
FIsErrorCorrectionSupport := True;
|
|
|
|
FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_ENDIAN_LITTLE,
|
|
SizeOf(b_bool), @b_bool, Size);
|
|
if b_bool <> 0 then
|
|
FIsHostUnifiedMemory := True;
|
|
|
|
FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_PROFILING_TIMER_RESOLUTION,
|
|
SizeOf(FProfilingTimerResolution), @FProfilingTimerResolution, Size);
|
|
FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_ENDIAN_LITTLE,
|
|
SizeOf(b_bool), @b_bool, Size);
|
|
if b_bool <> 0 then
|
|
FIsEndianLittle := True;
|
|
|
|
FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_AVAILABLE, SizeOf(b_bool),
|
|
@b_bool, Size);
|
|
if b_bool <> 0 then
|
|
FIsAvailable := True;
|
|
|
|
FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_COMPILER_AVAILABLE,
|
|
SizeOf(b_bool), @b_bool, Size);
|
|
if b_bool <> 0 then
|
|
FIsCompilerAvailable := True;
|
|
|
|
FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_VENDOR_ID, SizeOf(FVendorId),
|
|
@FVendorId, Size);
|
|
FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_MAX_COMPUTE_UNITS,
|
|
SizeOf(FMaxComputeUnits), @FMaxComputeUnits, Size);
|
|
FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_MAX_WORK_ITEM_DIMENSIONS,
|
|
SizeOf(FMaxWorkItemDimensions), @FMaxWorkItemDimensions, Size);
|
|
FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_EXTENSIONS, 0, nil, Size);
|
|
SetLength(FExtensionsString, Size);
|
|
FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_EXTENSIONS, Size,
|
|
@FExtensionsString[1], Size);
|
|
FExtensionsCount := 0;
|
|
i := 1;
|
|
while (i <= Length(FExtensionsString)) do
|
|
begin
|
|
if ((FExtensionsString[i] = ' ') or (FExtensionsString[i] = #0)) then
|
|
begin
|
|
if (i > 1) then
|
|
begin
|
|
if ((FExtensionsString[i - 1] <> ' ') and
|
|
(FExtensionsString[i - 1] <> #0)) then
|
|
begin
|
|
Inc(FExtensionsCount);
|
|
end;
|
|
end
|
|
else
|
|
Inc(FExtensionsCount);
|
|
end;
|
|
Inc(i);
|
|
end;
|
|
SetLength(FExtensions, FExtensionsCount);
|
|
previous := 1;
|
|
current := 1;
|
|
i := 0;
|
|
while (current <= Length(FExtensionsString)) do
|
|
begin
|
|
if ((FExtensionsString[current] = AnsiString(' ')) or
|
|
(FExtensionsString[current] = #0)) then
|
|
begin
|
|
if (current > previous) then
|
|
FExtensions[i] := UpperCase(Copy(FExtensionsString, previous,
|
|
current - previous - 1));
|
|
previous := current + 1;
|
|
Inc(i);
|
|
end;
|
|
Inc(current);
|
|
end;
|
|
|
|
FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_OPENCL_C_VERSION, 0,
|
|
nil, Size);
|
|
SetLength(FOpenCLCVersion, Size);
|
|
FStatus := clGetDeviceInfo(FDevice_id, CL_DEVICE_OPENCL_C_VERSION, Size,
|
|
@FOpenCLCVersion[1], Size);
|
|
FStatus := clGetDeviceInfo(FDevice_id, CL_DRIVER_VERSION, 0, nil, Size);
|
|
SetLength(FDriverVersion, Size);
|
|
FStatus := clGetDeviceInfo(FDevice_id, CL_DRIVER_VERSION, Size,
|
|
@FDriverVersion[1], Size);
|
|
FContext := TDCLContext.Create(FDevice_id);
|
|
end;
|
|
|
|
function TDCLDevice.CreateBuffer(const Size: Size_t; const Data: Pointer;
|
|
const Flags: TDCLMemFlagsSet): TDCLBuffer;
|
|
begin
|
|
Result := TDCLBuffer.Create(Context.FContext, Flags, Size, Data);
|
|
end;
|
|
|
|
function TDCLDevice.CreateCommandQueue(const Properties
|
|
: TDCLCommandQueuePropertiesSet): TDCLCommandQueue;
|
|
begin
|
|
Result := TDCLCommandQueue.Create(Device_Id, Context.FContext, Properties);
|
|
end;
|
|
|
|
function TDCLDevice.CreateContext: TDCLContext;
|
|
begin
|
|
Result := TDCLContext.Create(FDevice_id);
|
|
end;
|
|
|
|
function TDCLDevice.CreateProgram(const Source: PPChar; const Options: PPChar)
|
|
: TDCLProgram;
|
|
begin
|
|
Result := TDCLProgram.Create(FContext.FContext, Source, Options);
|
|
end;
|
|
|
|
function TDCLDevice.CreateImage2D(const Format: PCL_image_format;
|
|
const Width, Height, RowPitch: Size_t; const Data: Pointer;
|
|
const Flags: TDCLMemFlagsSet): TDCLImage2D;
|
|
begin
|
|
Result := TDCLImage2D.Create(Context.FContext, Flags, Format, Width, Height,
|
|
RowPitch, Data);
|
|
end;
|
|
|
|
function TDCLDevice.CreateProgram(const FileName: String; const Options: PPChar)
|
|
: TDCLProgram;
|
|
var
|
|
F: TextFile;
|
|
Source: String;
|
|
buf: String;
|
|
begin
|
|
AssignFile(F, FileName);
|
|
Reset(F);
|
|
Source := '';
|
|
while not(EOF(F)) do
|
|
begin
|
|
Readln(F, buf);
|
|
Source := Source + buf + #10 + #13;
|
|
end;
|
|
CloseFile(F);
|
|
Result := CreateProgram(@PString(Source), Options);
|
|
end;
|
|
|
|
procedure TDCLDevice.Free;
|
|
begin
|
|
FContext.Free();
|
|
SetLength(FExtensions, 0);
|
|
FExtensionsString := '';
|
|
inherited Free();
|
|
end;
|
|
|
|
function TDCLDevice.GetExtensions(const Index: Size_t): AnsiString;
|
|
begin
|
|
if Index < FExtensionsCount then
|
|
Result := FExtensions[Index]
|
|
else
|
|
Result := '';
|
|
end;
|
|
|
|
function TDCLDevice.IsPresentExtension(const ExtensionName: AnsiString)
|
|
: Boolean;
|
|
var
|
|
i: Integer;
|
|
UppName: AnsiString;
|
|
begin
|
|
Result := False;
|
|
UppName := UpperCase(ExtensionName);
|
|
for i := 0 to High(FExtensions) do
|
|
begin
|
|
if FExtensions[i] = UppName then
|
|
begin
|
|
Result := True;
|
|
Break;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{ TDCLContext }
|
|
|
|
constructor TDCLContext.Create(Device_Id: PCL_device_id);
|
|
(*
|
|
CL_CONTEXT_REFERENCE_COUNT
|
|
CL_CONTEXT_DEVICES
|
|
CL_CONTEXT_PROPERTIES
|
|
*)
|
|
var
|
|
Size: Size_t;
|
|
begin
|
|
inherited Create();
|
|
FContext := clCreateContext(nil, 1, @Device_Id, nil, nil, FStatus);
|
|
FStatus := clGetContextInfo(FContext, CL_CONTEXT_NUM_DEVICES,
|
|
SizeOf(FNumDevices), @FNumDevices, Size);
|
|
end;
|
|
|
|
{ TDCLQueue }
|
|
|
|
constructor TDCLCommandQueue.Create(const Device_Id: PCL_device_id;
|
|
const Context: PCL_context; const Properties: TDCLCommandQueuePropertiesSet);
|
|
var
|
|
props: CL_command_queue_properties;
|
|
begin
|
|
props := 0;
|
|
if cqpOutOfOrderExecModeEnable in Properties then
|
|
props := props or CL_QUEUE_OUT_OF_ORDER_EXEC_MODE_ENABLE;
|
|
FCommandQueue := clCreateCommandQueue(Context, Device_Id, props, FStatus);
|
|
FProperties := Properties;
|
|
end;
|
|
|
|
procedure TDCLContext.Free;
|
|
begin
|
|
FStatus := clReleaseContext(FContext);
|
|
inherited Free();
|
|
end;
|
|
|
|
{ TDCLBuffer }
|
|
|
|
constructor TDCLBuffer.Create(const Context: PCL_context;
|
|
const Flags: TDCLMemFlagsSet; const Size: Size_t; const Data: Pointer = nil);
|
|
var
|
|
fgs: CL_mem_flags;
|
|
begin
|
|
inherited Create();
|
|
fgs := 0;
|
|
if mfReadWrite in Flags then
|
|
fgs := fgs or CL_MEM_READ_WRITE;
|
|
if mfWriteOnly in Flags then
|
|
fgs := fgs or CL_MEM_WRITE_ONLY;
|
|
if mfReadOnly in Flags then
|
|
fgs := fgs or CL_MEM_READ_ONLY;
|
|
if mfUseHostPtr in Flags then
|
|
fgs := fgs or CL_MEM_USE_HOST_PTR;
|
|
if mfAllocHostPtr in Flags then
|
|
fgs := fgs or CL_MEM_ALLOC_HOST_PTR;
|
|
if mfCopyHostPtr in Flags then
|
|
fgs := fgs or CL_MEM_COPY_HOST_PTR;
|
|
FMem := clCreateBuffer(Context, fgs, Size, Data, FStatus);
|
|
FSize := Size;
|
|
end;
|
|
|
|
procedure TDCLBuffer.Free;
|
|
begin
|
|
FStatus := clReleaseMemObject(FMem);
|
|
inherited Free;
|
|
end;
|
|
|
|
procedure TDCLCommandQueue.Execute(const Kernel: TDCLKernel;
|
|
const Size: Size_t);
|
|
begin
|
|
FStatus := clEnqueueNDRangeKernel(FCommandQueue, Kernel.FKernel, 1, nil,
|
|
@Size, nil, 0, nil, nil);
|
|
FStatus := clFinish(FCommandQueue);
|
|
end;
|
|
|
|
procedure TDCLCommandQueue.Execute(const Kernel: TDCLKernel;
|
|
// const Device: PCL_device_id;
|
|
const Size: array of Size_t);
|
|
// var
|
|
// kernel2DWorkGroupSize: Size_t;
|
|
begin
|
|
// FStatus := clGetKernelWorkGroupInfo(Kernel.FKernel, Device, CL_KERNEL_WORK_GROUP_SIZE, SizeOf(Size_t), @kernel2DWorkGroupSize, nil);
|
|
FStatus := clEnqueueNDRangeKernel(FCommandQueue, Kernel.FKernel, Length(Size),
|
|
nil, @Size[0], nil, 0, nil, nil);
|
|
FStatus := clFinish(FCommandQueue);
|
|
end;
|
|
|
|
procedure TDCLCommandQueue.Free;
|
|
begin
|
|
FStatus := clReleaseCommandQueue(FCommandQueue);
|
|
inherited Free();
|
|
end;
|
|
|
|
{ TDCLProgram }
|
|
|
|
constructor TDCLProgram.Create(const Context: PCL_context; const Source: PPChar;
|
|
const Options: PPChar);
|
|
var
|
|
Size: Size_t;
|
|
// FBinaries: Array of Char;
|
|
begin
|
|
FProgram := clCreateProgramWithSource(Context, 1, Source, nil, FStatus);
|
|
FStatus := clBuildProgram(FProgram, 0, nil, Options^, nil, nil);
|
|
FStatus := clGetProgramInfo(FProgram, CL_PROGRAM_SOURCE, 0, nil, Size);
|
|
FSource := GetMemory(Size);
|
|
FStatus := clGetProgramInfo(FProgram, CL_PROGRAM_SOURCE, Size, FSource, Size);
|
|
FStatus := clGetProgramInfo(FProgram, CL_PROGRAM_BINARY_SIZES, 0, nil,
|
|
FBinarySizesCount);
|
|
SetLength(FBinarySizes, FBinarySizesCount);
|
|
FStatus := clGetProgramInfo(FProgram, CL_PROGRAM_BINARY_SIZES,
|
|
SizeOf(FBinarySizes), @FBinarySizes[0], FBinarySizesCount);
|
|
(* //Not yet
|
|
FStatus := clGetProgramInfo(FProgram,CL_PROGRAM_BINARIES,0,nil,@Size);
|
|
SetLength(FBinaries,Size);
|
|
FStatus := clGetProgramInfo(FProgram,CL_PROGRAM_BINARIES,Size,@FBinaries[0],nil);
|
|
Writeln(String(FBinaries));
|
|
*)
|
|
|
|
end;
|
|
|
|
function TDCLProgram.CreateKernel(const KernelName: PPChar): TDCLKernel;
|
|
begin
|
|
Result := TDCLKernel.Create(FProgram, KernelName);
|
|
end;
|
|
|
|
procedure TDCLProgram.Free;
|
|
begin
|
|
FStatus := clReleaseProgram(FProgram);
|
|
FSource := '';
|
|
SetLength(FBinarySizes, 0);
|
|
inherited Free;
|
|
end;
|
|
|
|
function TDCLProgram.GetBinarySizes(const Index: Size_t): Size_t;
|
|
begin
|
|
if (Index < FBinarySizesCount) then
|
|
Result := FBinarySizes[Index]
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
{ TDCLKernel }
|
|
|
|
constructor TDCLKernel.Create(const Program_: PCL_program;
|
|
const KernelName: PPChar);
|
|
begin
|
|
FKernel := clCreateKernel(Program_, KernelName^, FStatus);
|
|
end;
|
|
|
|
procedure TDCLKernel.Free;
|
|
begin
|
|
FStatus := clReleaseKernel(FKernel);
|
|
inherited Free();
|
|
end;
|
|
|
|
function TDCLKernel.GetFunctionName: AnsiString;
|
|
var
|
|
Size: Size_t;
|
|
Buffer: Array of AnsiChar;
|
|
begin
|
|
FStatus := clGetKernelInfo(FKernel, CL_KERNEL_FUNCTION_NAME, 0, nil, Size);
|
|
SetLength(Buffer, Size);
|
|
FStatus := clGetKernelInfo(FKernel, CL_KERNEL_FUNCTION_NAME, Size,
|
|
@Buffer[0], Size);
|
|
Result := AnsiString(Buffer);
|
|
SetLength(Buffer, 0);
|
|
end;
|
|
|
|
function TDCLKernel.GetNumArgs: CL_uint;
|
|
var
|
|
Size: Size_t;
|
|
begin
|
|
FStatus := clGetKernelInfo(FKernel, CL_KERNEL_NUM_ARGS, SizeOf(Result),
|
|
@Result, Size);
|
|
end;
|
|
|
|
procedure TDCLKernel.SetArg(const Index: CL_uint; const Size: Size_t;
|
|
const Value: Pointer);
|
|
begin
|
|
FStatus := clSetKernelArg(FKernel, Index, Size, Value);
|
|
end;
|
|
|
|
procedure TDCLKernel.SetArg(const Index: CL_uint; const Value: TDCLBuffer);
|
|
begin
|
|
SetArg(Index, SizeOf(@Value.FMem), @Value.FMem);
|
|
end;
|
|
|
|
procedure TDCLKernel.SetArg(const Index: CL_uint; const Value: TDCLImage2D);
|
|
begin
|
|
SetArg(Index, SizeOf(@Value.FMem), @Value.FMem);
|
|
end;
|
|
|
|
procedure TDCLCommandQueue.ReadBuffer(const Buffer: TDCLBuffer;
|
|
const Size: Size_t; const Data: Pointer);
|
|
begin
|
|
FStatus := clEnqueueReadBuffer(FCommandQueue, Buffer.FMem, CL_TRUE, 0, Size,
|
|
Data, 0, nil, nil);
|
|
clFinish(FCommandQueue);
|
|
end;
|
|
|
|
procedure TDCLCommandQueue.ReadImage2D(const Image: TDCLImage2D;
|
|
const Width, Height: Size_t; const Data: Pointer);
|
|
var
|
|
origin, region: Array [0 .. 2] of Size_t;
|
|
begin
|
|
ZeroMemory(@origin, SizeOf(origin));
|
|
region[0] := Width;
|
|
region[1] := Height;
|
|
region[2] := 1; // Image 2D
|
|
FStatus := clEnqueueReadImage(FCommandQueue, Image.FMem, CL_TRUE, @origin,
|
|
@region, 0, 0, Data, 0, nil, nil);
|
|
FStatus := clFinish(FCommandQueue);
|
|
end;
|
|
|
|
procedure TDCLCommandQueue.WriteImage2D(const Image: TDCLImage2D;
|
|
const Width, Height: Size_t; const Data: Pointer);
|
|
var
|
|
origin, region: Array [0 .. 2] of Size_t;
|
|
begin
|
|
ZeroMemory(@origin, SizeOf(origin));
|
|
region[0] := Width;
|
|
region[1] := Height;
|
|
region[2] := 1; // Image 2D
|
|
FStatus := clEnqueueWriteImage(FCommandQueue, Image.FMem, CL_TRUE, @origin,
|
|
@region, 0, 0, Data, 0, nil, nil);
|
|
FStatus := clFinish(FCommandQueue);
|
|
end;
|
|
|
|
procedure TDCLCommandQueue.WriteBuffer(const Buffer: TDCLBuffer;
|
|
const Size: Size_t; const Data: Pointer);
|
|
begin
|
|
FStatus := clEnqueueWriteBuffer(FCommandQueue, Buffer.FMem, CL_TRUE, 0, Size,
|
|
Data, 0, nil, nil);
|
|
end;
|
|
|
|
{ TDCLImage2D }
|
|
|
|
constructor TDCLImage2D.Create(const Context: PCL_context;
|
|
const Flags: TDCLMemFlagsSet; const Format: PCL_image_format;
|
|
const Width, Height, RowPitch: Size_t; const Data: Pointer);
|
|
var
|
|
fgs: CL_mem_flags;
|
|
begin
|
|
inherited Create();
|
|
fgs := 0;
|
|
if mfReadWrite in Flags then
|
|
fgs := fgs or CL_MEM_READ_WRITE;
|
|
if mfWriteOnly in Flags then
|
|
fgs := fgs or CL_MEM_WRITE_ONLY;
|
|
if mfReadOnly in Flags then
|
|
fgs := fgs or CL_MEM_READ_ONLY;
|
|
if mfUseHostPtr in Flags then
|
|
fgs := fgs or CL_MEM_USE_HOST_PTR;
|
|
if mfAllocHostPtr in Flags then
|
|
fgs := fgs or CL_MEM_ALLOC_HOST_PTR;
|
|
if mfCopyHostPtr in Flags then
|
|
fgs := fgs or CL_MEM_COPY_HOST_PTR;
|
|
FFormat := Format^;
|
|
FMem := clCreateImage2D(Context, fgs, @FFormat, Width, Height, RowPitch,
|
|
Data, FStatus);
|
|
end;
|
|
|
|
procedure TDCLImage2D.Free;
|
|
begin
|
|
FStatus := clReleaseMemObject(FMem);
|
|
inherited Free();
|
|
end;
|
|
|
|
end.
|