Skip to content

Commit

Permalink
Full repack
Browse files Browse the repository at this point in the history
  • Loading branch information
@SunSerega
SunSerega committed Dec 28, 2023
1 parent e119ea4 commit 4724bcc
Show file tree
Hide file tree
Showing 20 changed files with 412 additions and 35 deletions.
2 changes: 1 addition & 1 deletion .github/workflows/on commit.yaml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -43,7 +43,7 @@ jobs:
- name: Download and unpack Pascal compiler
run: |
Invoke-WebRequest -Uri 'https://github.com/SunSerega/pascalabcnet/releases/download/unstable/PABCNETC.zip' -OutFile 'D:\PABCNETC.zip'
Invoke-WebRequest -Uri 'https://github.com/SunSerega/pascalabcnet/releases/download/custom-build-tag/PABCNETC.zip' -OutFile 'D:\PABCNETC.zip'
Expand-Archive -Path 'D:\PABCNETC.zip' -DestinationPath 'D:\PABCNETC' -Force
Expand Down
2 changes: 1 addition & 1 deletion DataScraping/Reps/OpenCL-Docs
Submodule OpenCL-Docs updated from 81ad45 to 2d470a
Binary file modified DataScraping/XML/OpenCL/funcs.bin
View file
Binary file not shown.
4 changes: 2 additions & 2 deletions LastPack.log
View file
Original file line number Diff line number Diff line change
Expand Up @@ -56,7 +56,7 @@ ScrapXML[OpenCL]: Parsing "cl"
ScrapXML[OpenCL]: Constructing named items
ScrapXML[OpenCL]: Saving as binary
ScrapXML[OpenCL]: VendorSuffix: Saved 11 items
ScrapXML[OpenCL]: Enum: Saved 1119 items
ScrapXML[OpenCL]: Enum: Saved 1125 items
ScrapXML[OpenCL]: BasicType: Saved 30 items
ScrapXML[OpenCL]: Group: Saved 119 items
ScrapXML[OpenCL]: IdClass: Saved 18 items
Expand Down Expand Up @@ -249,7 +249,7 @@ Template[OpenCL]: TemplateCommand[LowLvl/OpenCL/Pack Essentials.exe]: Dumping Id
Template[OpenCL]: TemplateCommand[LowLvl/OpenCL/Pack Essentials.exe]: Dumping Struct items
Template[OpenCL]: TemplateCommand[LowLvl/OpenCL/Pack Essentials.exe]: Dumping Delegate items
Template[OpenCL]: TemplateCommand[LowLvl/OpenCL/Pack Essentials.exe]: PascalBasicType: Packed 12 items
Template[OpenCL]: TemplateCommand[LowLvl/OpenCL/Pack Essentials.exe]: Group: Packed 111 items
Template[OpenCL]: TemplateCommand[LowLvl/OpenCL/Pack Essentials.exe]: Group: Packed 112 items
Template[OpenCL]: TemplateCommand[LowLvl/OpenCL/Pack Essentials.exe]: IdClass: Packed 28 items
Template[OpenCL]: TemplateCommand[LowLvl/OpenCL/Pack Essentials.exe]: Struct: Packed 17 items
Template[OpenCL]: TemplateCommand[LowLvl/OpenCL/Pack Essentials.exe]: Delegate: Packed 7 items
Expand Down
2 changes: 1 addition & 1 deletion Log/FirstPack.log
View file
Original file line number Diff line number Diff line change
Expand Up @@ -46,7 +46,7 @@ ScrapXML[OpenCL]: Parsing "cl"
ScrapXML[OpenCL]: Constructing named items
ScrapXML[OpenCL]: Saving as binary
ScrapXML[OpenCL]: VendorSuffix: Saved 11 items
ScrapXML[OpenCL]: Enum: Saved 1119 items
ScrapXML[OpenCL]: Enum: Saved 1125 items
ScrapXML[OpenCL]: BasicType: Saved 30 items
ScrapXML[OpenCL]: Group: Saved 119 items
ScrapXML[OpenCL]: IdClass: Saved 18 items
Expand Down
2 changes: 1 addition & 1 deletion Log/OpenCL.log
View file
Original file line number Diff line number Diff line change
Expand Up @@ -103,7 +103,7 @@ Template[OpenCL]: TemplateCommand[LowLvl/OpenCL/Pack Essentials.exe]: Dumping Id
Template[OpenCL]: TemplateCommand[LowLvl/OpenCL/Pack Essentials.exe]: Dumping Struct items
Template[OpenCL]: TemplateCommand[LowLvl/OpenCL/Pack Essentials.exe]: Dumping Delegate items
Template[OpenCL]: TemplateCommand[LowLvl/OpenCL/Pack Essentials.exe]: PascalBasicType: Packed 12 items
Template[OpenCL]: TemplateCommand[LowLvl/OpenCL/Pack Essentials.exe]: Group: Packed 111 items
Template[OpenCL]: TemplateCommand[LowLvl/OpenCL/Pack Essentials.exe]: Group: Packed 112 items
Template[OpenCL]: TemplateCommand[LowLvl/OpenCL/Pack Essentials.exe]: IdClass: Packed 28 items
Template[OpenCL]: TemplateCommand[LowLvl/OpenCL/Pack Essentials.exe]: Struct: Packed 17 items
Template[OpenCL]: TemplateCommand[LowLvl/OpenCL/Pack Essentials.exe]: Delegate: Packed 7 items
Expand Down
81 changes: 81 additions & 0 deletions Modules.Packed/OpenCL.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1832,6 +1832,7 @@ clDeviceInfo = record
public static property DEVICE_PAGE_SIZE: clDeviceInfo read new clDeviceInfo($40A1);
public static property DEVICE_SVM_CAPABILITIES_ARM: clDeviceInfo read new clDeviceInfo($40B6);
public static property DEVICE_COMPUTE_UNITS_BITFIELD: clDeviceInfo read new clDeviceInfo($40BF);
public static property DEVICE_MEMORY_CAPABILITIES: clDeviceInfo read new clDeviceInfo($40D8);
public static property DEVICE_SPIR_VERSIONS: clDeviceInfo read new clDeviceInfo($40E0);
public static property DEVICE_SIMULTANEOUS_INTEROPS: clDeviceInfo read new clDeviceInfo($4104);
public static property DEVICE_NUM_SIMULTANEOUS_INTEROPS: clDeviceInfo read new clDeviceInfo($4105);
Expand Down Expand Up @@ -2203,6 +2204,8 @@ clDeviceInfo = record
Result := 'DEVICE_SVM_CAPABILITIES_ARM' else
if DEVICE_COMPUTE_UNITS_BITFIELD = self then
Result := 'DEVICE_COMPUTE_UNITS_BITFIELD' else
if DEVICE_MEMORY_CAPABILITIES = self then
Result := 'DEVICE_MEMORY_CAPABILITIES' else
if DEVICE_SPIR_VERSIONS = self then
Result := 'DEVICE_SPIR_VERSIONS' else
if DEVICE_SIMULTANEOUS_INTEROPS = self then
Expand Down Expand Up @@ -5202,6 +5205,76 @@ clDevicePartitionPropertyEXT = record

end;

///
clMemAllocFlagsIMG = record
public val: UInt64;
public constructor(val: UInt64) := self.val := val;

public static property MEM_ALLOC_RELAX_REQUIREMENTS: clMemAllocFlagsIMG read new clMemAllocFlagsIMG(1 shl 0);
public static property MEM_ALLOC_GPU_WRITE_COMBINE: clMemAllocFlagsIMG read new clMemAllocFlagsIMG(1 shl 1);
public static property MEM_ALLOC_GPU_CACHED: clMemAllocFlagsIMG read new clMemAllocFlagsIMG(1 shl 2);
public static property MEM_ALLOC_CPU_LOCAL: clMemAllocFlagsIMG read new clMemAllocFlagsIMG(1 shl 3);
public static property MEM_ALLOC_GPU_LOCAL: clMemAllocFlagsIMG read new clMemAllocFlagsIMG(1 shl 4);
public static property MEM_ALLOC_GPU_PRIVATE: clMemAllocFlagsIMG read new clMemAllocFlagsIMG(1 shl 5);

public static function operator+(v1, v2: clMemAllocFlagsIMG) := new clMemAllocFlagsIMG(v1.val or v2.val);
public static function operator or(v1, v2: clMemAllocFlagsIMG) := new clMemAllocFlagsIMG(v1.val or v2.val);

public static procedure operator+=(var v1: clMemAllocFlagsIMG; v2: clMemAllocFlagsIMG) := v1 := v1+v2;

public static function operator in(v1, v2: clMemAllocFlagsIMG) := v1.val and v2.val = v1.val;

public function ToString: string; override;
begin
var res := new StringBuilder;
var left_val := self.val;
if left_val=0 then
begin
Result := 'clMemAllocFlagsIMG[0]';
exit;
end;
if MEM_ALLOC_RELAX_REQUIREMENTS in self then
begin
res += 'MEM_ALLOC_RELAX_REQUIREMENTS+';
left_val := left_val and not MEM_ALLOC_RELAX_REQUIREMENTS.val;
end;
if MEM_ALLOC_GPU_WRITE_COMBINE in self then
begin
res += 'MEM_ALLOC_GPU_WRITE_COMBINE+';
left_val := left_val and not MEM_ALLOC_GPU_WRITE_COMBINE.val;
end;
if MEM_ALLOC_GPU_CACHED in self then
begin
res += 'MEM_ALLOC_GPU_CACHED+';
left_val := left_val and not MEM_ALLOC_GPU_CACHED.val;
end;
if MEM_ALLOC_CPU_LOCAL in self then
begin
res += 'MEM_ALLOC_CPU_LOCAL+';
left_val := left_val and not MEM_ALLOC_CPU_LOCAL.val;
end;
if MEM_ALLOC_GPU_LOCAL in self then
begin
res += 'MEM_ALLOC_GPU_LOCAL+';
left_val := left_val and not MEM_ALLOC_GPU_LOCAL.val;
end;
if MEM_ALLOC_GPU_PRIVATE in self then
begin
res += 'MEM_ALLOC_GPU_PRIVATE+';
left_val := left_val and not MEM_ALLOC_GPU_PRIVATE.val;
end;
if left_val<>0 then
begin
res += 'clMemAllocFlagsIMG[';
res += self.val.ToString;
res += ']+';
end;
res.Length -= 1;
Result := res.ToString;
end;

end;

///
clMemAllocFlagsINTEL = record
public val: UInt64;
Expand Down Expand Up @@ -11099,6 +11172,14 @@ cl_queue_family_properties = record
if param_value_validate_size and (param_value_ret_size<>param_value_sz) then
raise new InvalidOperationException($'Implementation returned a size of {param_value_ret_size} instead of {param_value_sz}');
end;
public [MethodImpl(MethodImplOptions.AggressiveInlining)] static function GetDeviceInfo_DEVICE_MEMORY_CAPABILITIES(device: cl_device_id; var param_value: clMemAllocFlagsIMG; param_value_validate_size: boolean := false): clErrorCode;
begin
var param_value_sz := new UIntPtr(Marshal.SizeOf&<clMemAllocFlagsIMG>);
var param_value_ret_size: UIntPtr;
Result := GetDeviceInfo(device, clDeviceInfo.DEVICE_MEMORY_CAPABILITIES, param_value_sz,param_value,param_value_ret_size);
if param_value_validate_size and (param_value_ret_size<>param_value_sz) then
raise new InvalidOperationException($'Implementation returned a size of {param_value_ret_size} instead of {param_value_sz}');
end;
public [MethodImpl(MethodImplOptions.AggressiveInlining)] static function GetDeviceInfo_DEVICE_SPIR_VERSIONS(device: cl_device_id; var param_value: string): clErrorCode;
begin
var param_value_sz: UIntPtr;
Expand Down
57 changes: 48 additions & 9 deletions Modules.Packed/OpenCLABC.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -57,6 +57,12 @@
//===================================
// Обязательно сделать до следующей стабильной версии:

//TODO Сеттеры параметров не всегда известно, нужны ли
// - Добавить параметр "unuse_is_error := true"

//TODO При создании CLArray и т.п. указывается map_use, но влияет он и на .ReadArray и т.п.
// - Перетестить и переименовать... host_use?

//TODO Если кинуло AggEx, возвращать из тестов его внутренний массив исключений
// - TestExecutor сейчас возвращает исключение текстом... Ужас
//TODO Устечка памяти в виде ивентов после исключения в очереди
Expand Down Expand Up @@ -1525,15 +1531,15 @@ EventRetainReleaseData = record

CLMemoryObserver = static class

public static auto property &Default: MemoryObserver := new EmptyMemoryObserver;
public static auto property Current: MemoryObserver := new EmptyMemoryObserver;

private static procedure ReportFree(ntv: cl_mem{$ifdef DEBUG}; mem_obj: object{$endif});
begin
var sz: UIntPtr;
OpenCLABCInternalException.RaiseIfError(
cl.GetMemObjectInfo_MEM_SIZE(ntv, sz)
);
&Default.RemoveMemoryUse(sz.ToUInt64, {$ifdef DEBUG}mem_obj{$else}ntv{$endif});
Current.RemoveMemoryUse(sz.ToUInt64, {$ifdef DEBUG}mem_obj{$else}ntv{$endif});
end;

end;
Expand Down Expand Up @@ -2391,6 +2397,10 @@ CLDeviceProperties = class
begin
cl.GetDeviceInfo_DEVICE_FEATURE_CAPABILITIES(self.ntv, Result).RaiseIfError;
end;
private function GetMemoryCapabilities: clMemAllocFlagsIMG;
begin
cl.GetDeviceInfo_DEVICE_MEMORY_CAPABILITIES(self.ntv, Result).RaiseIfError;
end;

public property &Type: clDeviceType read GetType;
public property VendorId: clKhronosVendorId read GetVendorId;
Expand Down Expand Up @@ -2569,6 +2579,7 @@ CLDeviceProperties = class
public property NumEusPerSubSlice: UInt32 read GetNumEusPerSubSlice;
public property NumThreadsPerEu: UInt32 read GetNumThreadsPerEu;
public property FeatureCapabilities: clDeviceFeatureCapabilities read GetFeatureCapabilities;
public property MemoryCapabilities: clMemAllocFlagsIMG read GetMemoryCapabilities;

private static procedure AddProp<T>(res: StringBuilder; get_prop: ()->T) :=
try
Expand Down Expand Up @@ -2755,7 +2766,8 @@ CLDeviceProperties = class
res += 'NumSubSlicesPerSlice = '; AddProp(res, GetNumSubSlicesPerSlice ); res += #10;
res += 'NumEusPerSubSlice = '; AddProp(res, GetNumEusPerSubSlice ); res += #10;
res += 'NumThreadsPerEu = '; AddProp(res, GetNumThreadsPerEu ); res += #10;
res += 'FeatureCapabilities = '; AddProp(res, GetFeatureCapabilities );
res += 'FeatureCapabilities = '; AddProp(res, GetFeatureCapabilities ); res += #10;
res += 'MemoryCapabilities = '; AddProp(res, GetMemoryCapabilities );
end;
public function ToString: string; override;
begin
Expand Down Expand Up @@ -4213,6 +4225,25 @@ CLProgramLinkOptions = class(CLProgramOptions)
begin
self.code := code;
self.k_name := k_name;

// Create one instance, to check if everything is valid
var ec: clErrorCode;
var k := cl.CreateKernel(code.ntv, k_name, ec);

if ec.IS_ERROR then
begin
if ec=clErrorCode.INVALID_KERNEL_NAME then
begin
var names: string;
OpenCLABCInternalException.RaiseIfError(
cl.GetProgramInfo_PROGRAM_KERNEL_NAMES(code.ntv, names)
);
raise new OpenCLABCInternalException($'Kernel [{k_name}] is not defined in {code}. Existing kernel names: {names}');
end;
OpenCLABCInternalException.RaiseIfError(ec);
end;

AddExistingNative(k);
end;

public constructor(ntv: cl_kernel);
Expand Down Expand Up @@ -4369,7 +4400,7 @@ CLMemoryUsage = record
self.ntv := cl.CreateBuffer(c.ntv, CLMemoryUsage.MakeCLFlags(kernel_use,map_use), size, nil, ec);
OpenCLABCInternalException.RaiseIfError(ec);

CLMemoryObserver.Default.AddMemoryUse(size.ToUInt64, {$ifdef DEBUG}new CLMemoryAlloc(self, ntv){$else}ntv{$endif});
CLMemoryObserver.Current.AddMemoryUse(size.ToUInt64, {$ifdef DEBUG}new CLMemoryAlloc(self, ntv){$else}ntv{$endif});

end;
public constructor(size: integer; c: CLContext; kernel_use: CLMemoryUsage := CLMemoryUsage.read_write_bits; map_use: CLMemoryUsage := CLMemoryUsage.read_write_bits) :=
Expand Down Expand Up @@ -5042,7 +5073,7 @@ CLMemoryUsage = record
self.ntv := cl.CreateBuffer(c.ntv, CLMemoryUsage.MakeCLFlags(kernel_use,map_use), new UIntPtr(ValueSize), nil, ec);
OpenCLABCInternalException.RaiseIfError(ec);

CLMemoryObserver.Default.AddMemoryUse(ValueSize, {$ifdef DEBUG}new CLMemoryAlloc(self, ntv){$else}ntv{$endif});
CLMemoryObserver.Current.AddMemoryUse(ValueSize, {$ifdef DEBUG}new CLMemoryAlloc(self, ntv){$else}ntv{$endif});

end;
public constructor(c: CLContext; val: T; kernel_use: CLMemoryUsage := CLMemoryUsage.read_write_bits; map_use: CLMemoryUsage := CLMemoryUsage.read_write_bits);
Expand All @@ -5052,7 +5083,7 @@ CLMemoryUsage = record
self.ntv := cl.CreateBuffer(c.ntv, CLMemoryUsage.MakeCLFlags(kernel_use,map_use) + clMemFlags.MEM_COPY_HOST_PTR, new UIntPtr(ValueSize), val, ec);
OpenCLABCInternalException.RaiseIfError(ec);

CLMemoryObserver.Default.AddMemoryUse(ValueSize, {$ifdef DEBUG}new CLMemoryAlloc(self, ntv){$else}ntv{$endif});
CLMemoryObserver.Current.AddMemoryUse(ValueSize, {$ifdef DEBUG}new CLMemoryAlloc(self, ntv){$else}ntv{$endif});

end;

Expand Down Expand Up @@ -5172,7 +5203,7 @@ CLMemoryUsage = record
self.ntv := cl.CreateBuffer(c.ntv, CLMemoryUsage.MakeCLFlags(kernel_use,map_use), new UIntPtr(ByteSize), nil, ec);
OpenCLABCInternalException.RaiseIfError(ec);

CLMemoryObserver.Default.AddMemoryUse(ByteSize, {$ifdef DEBUG}new CLMemoryAlloc(self, ntv){$else}ntv{$endif});
CLMemoryObserver.Current.AddMemoryUse(ByteSize, {$ifdef DEBUG}new CLMemoryAlloc(self, ntv){$else}ntv{$endif});

end;
private procedure InitByVal(c: CLContext; var els: T; kernel_use, map_use: CLMemoryUsage);
Expand All @@ -5182,7 +5213,7 @@ CLMemoryUsage = record
self.ntv := cl.CreateBuffer(c.ntv, CLMemoryUsage.MakeCLFlags(kernel_use,map_use) + clMemFlags.MEM_COPY_HOST_PTR, new UIntPtr(ByteSize), els, ec);
OpenCLABCInternalException.RaiseIfError(ec);

CLMemoryObserver.Default.AddMemoryUse(ByteSize, {$ifdef DEBUG}new CLMemoryAlloc(self, ntv){$else}ntv{$endif});
CLMemoryObserver.Current.AddMemoryUse(ByteSize, {$ifdef DEBUG}new CLMemoryAlloc(self, ntv){$else}ntv{$endif});

end;

Expand Down Expand Up @@ -37491,6 +37522,12 @@ GLIteropApiBlock = record
var prev_ev := l.AttachInvokeActions(g{$ifdef EventDebug}, l{$endif});
var res_ev: cl_event;
InvokeImpl(api_block, g.GetCQ(false), ntv_mem_objs, prev_ev, res_ev);
//TODO Проверить и сделать всё релевантное из EnqueueableCore
// - В частности что если enq_ev=0 из за предыдущих ошибок? Может ли тут NV тоже отказываться давать ивент?
// - И сделать issue в OpenCL-Docs об этом, типа кто прав (или оба?)
{$ifdef EventDebug}
EventDebug.RegisterEventRetain(res_ev, $'Enq by {TypeName(self)}, waiting on: {prev_ev.evs?.Take(prev_ev.count).JoinToString}');
{$endif EventDebug}
Result := new QueueResNil(prev_ev + res_ev);
end;

Expand Down Expand Up @@ -37954,7 +37991,9 @@ procedure CLArray<T>.SetSliceProp(range: IntRange; value: array of T) :=
end;

begin
var left_mem_objs := EmptyMemoryObserver(CLMemoryObserver.Default).impl.mem_uses.Keys;
var obs := CLMemoryObserver.Current as TrackingMemoryObserver;
if obs=nil then obs := EmptyMemoryObserver(CLMemoryObserver.Current).impl;
var left_mem_objs := obs.mem_uses.Keys;
if left_mem_objs.Any then
raise new OpenCLABCInternalException($'Not all memory objects were disposed: ' + left_mem_objs.JoinToString);
end;
Expand Down
Loading

0 comments on commit 4724bcc

Please sign in to comment.