administrator/pascalabcnet
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

fix #2055

Browse source
This commit is contained in:
Mikhalkovich Stanislav 2019-07-27 17:33:55 +03:00
parent 18272e692b
commit f8653deb7f
12 changed files with 23315 additions and 3876 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
Configuration/GlobalAssemblyInfo.cs
View file

@ -15,7 +15,7 @@ internal static class RevisionClass
public const string Major = "3";
public const string Minor = "5";
public const string Build = "0";
public const string Revision = "2209";
public const string Revision = "2217";
public const string MainVersion = Major + "." + Minor;
public const string FullVersion = Major + "." + Minor + "." + Build + "." + Revision;

2
Configuration/Version.defs
View file

@ -1,4 +1,4 @@
%MINOR%=5
%REVISION%=2209
%REVISION%=2217
%COREVERSION%=0
%MAJOR%=3

2
Release/pabcversion.txt
View file

@ -1 +1 @@
3.5.0.2209
3.5.0.2217

2
ReleaseGenerators/PascalABCNET_version.nsh
View file

@ -1 +1 @@
!define VERSION '3.5.0.2209'
!define VERSION '3.5.0.2217'

2
ReleaseGenerators/RebuildStandartModules.pas
View file

@ -11,7 +11,7 @@
NumLibABC,
IniFile, PointerTools, PointRect, PT4, PT4MakerNetX, Robot, RobotField,
RobotTaskMaker, RobotZadan, Sockets, Utils, VCL, Timers, PT4Exam, PT4TaskMakerNET, RBDMUtils,
Collections, Arrays, Core, FormsABC, MPI, ClientServer, OpenGL, Speech, Sounds, Countries,
Collections, Arrays, Core, FormsABC, MPI, ClientServer, Speech, Sounds, Countries,
ABCDatabases,BlockFileOfT,Controls,
OpenCL, OpenCLABC,
OpenGL, OpenGLABC

9
TestSuite/CompilationSamples/MaxT1.pas Normal file
View file

@ -0,0 +1,9 @@
type
t1 = class
o: integer;
end;
begin
var sq: sequence of t1 := Arr(new t1);
var i: integer := sq.Max(a->a.o); //Ошибка : Нельзя преобразовать тип real к integer
end.

34
TestSuite/CompilationSamples/OpenCL.pas
View file

@ -15,7 +15,7 @@
/// Код переведён отсюда:
/// https://github.com/KhronosGroup/OpenCL-Headers/tree/master/CL
///
/// Справка:
/// Спецификация (что то типа справки):
/// www.khronos.org/registry/OpenCL/specs/2.2/html/OpenCL_API.html
///
/// Если чего то не хватает - писать сюда:
@ -23,6 +23,8 @@
///
unit OpenCL;
//ToDo ^T -> pointer
//ToDo расширения с котороми я не знаю что делать:
//
// - cl_ext.h
@ -38,7 +40,7 @@ unit OpenCL;
// - cl_platform.h
// -- есть только описание типов и констант, которые нигде не используются. Где они нужны?
//
//ToDo кто что то знает - напишите в issue, пожалуйста
// кто что то знает - напишите в issue, пожалуйста
//ToDo .h файлы которые осталось перевести:
// - cl_ext_intel
@ -1414,7 +1416,7 @@ type
type
[UnmanagedFunctionPointer(CallingConvention.StdCall)]
CreateContext_Callback = procedure(errinfo: ^char; private_info: pointer; cb: UIntPtr; user_data: pointer);
CreateContext_Callback = procedure(errinfo_text: IntPtr; private_info: pointer; cb: UIntPtr; user_data: pointer);
[UnmanagedFunctionPointer(CallingConvention.StdCall)]
Program_Callback = procedure(&program: cl_program; user_data: pointer);
@ -1935,7 +1937,7 @@ type
static function CreateProgramWithSource(context: cl_context; count: UInt32; [MarshalAs(UnmanagedType.LPArray, ArraySubType = UnmanagedType.LPStr)] strings: array of string; [MarshalAs(UnmanagedType.LPArray)] lengths: array of UIntPtr; var errcode_ret: ErrorCode): cl_program;
external 'opencl.dll' name 'clCreateProgramWithSource';
static function CreateProgramWithSource(context: cl_context; count: UInt32; strings: ^^char; lengths: ^UIntPtr; errcode_ret: ^ErrorCode): cl_program;
static function CreateProgramWithSource(context: cl_context; count: UInt32; strings: ^IntPtr; lengths: ^UIntPtr; errcode_ret: ^ErrorCode): cl_program;
external 'opencl.dll' name 'clCreateProgramWithSource';
static function CreateProgramWithIL(context: cl_context; il: IntPtr; length: UIntPtr; var errcode_ret: ErrorCode): cl_program;
@ -1954,11 +1956,11 @@ type
static function CreateProgramWithBuiltInKernels(context: cl_context; num_devices: UInt32; [MarshalAs(UnmanagedType.LPArray)] device_list: array of cl_device_id; [MarshalAs(UnmanagedType.LPStr)] kernel_names: string; var errcode_ret: ErrorCode): cl_program;
external 'opencl.dll' name 'clCreateProgramWithBuiltInKernels';
static function CreateProgramWithBuiltInKernels(context: cl_context; num_devices: UInt32; [MarshalAs(UnmanagedType.LPArray)] device_list: array of cl_device_id; kernel_names: ^char; var errcode_ret: ErrorCode): cl_program;
static function CreateProgramWithBuiltInKernels(context: cl_context; num_devices: UInt32; [MarshalAs(UnmanagedType.LPArray)] device_list: array of cl_device_id; kernel_names: IntPtr; var errcode_ret: ErrorCode): cl_program;
external 'opencl.dll' name 'clCreateProgramWithBuiltInKernels';
static function CreateProgramWithBuiltInKernels(context: cl_context; num_devices: UInt32; device_list: ^cl_device_id; [MarshalAs(UnmanagedType.LPStr)] kernel_names: string; errcode_ret: ^ErrorCode): cl_program;
external 'opencl.dll' name 'clCreateProgramWithBuiltInKernels';
static function CreateProgramWithBuiltInKernels(context: cl_context; num_devices: UInt32; device_list: ^cl_device_id; kernel_names: ^char; errcode_ret: ^ErrorCode): cl_program;
static function CreateProgramWithBuiltInKernels(context: cl_context; num_devices: UInt32; device_list: ^cl_device_id; kernel_names: IntPtr; errcode_ret: ^ErrorCode): cl_program;
external 'opencl.dll' name 'clCreateProgramWithBuiltInKernels';
static function RetainProgram(&program: cl_program): ErrorCode;
@ -1979,17 +1981,29 @@ type
static function BuildProgram(&program: cl_program; num_devices: UInt32; [MarshalAs(UnmanagedType.LPArray)] device_list: array of cl_device_id; [MarshalAs(UnmanagedType.LPStr)] options: string; pfn_notify: Program_Callback; user_data: IntPtr): ErrorCode;
external 'opencl.dll' name 'clBuildProgram';
static function BuildProgram(&program: cl_program; num_devices: UInt32; device_list: ^cl_device_id; options: ^char; pfn_notify: Program_Callback; user_data: pointer): ErrorCode;
static function BuildProgram(&program: cl_program; num_devices: UInt32; [MarshalAs(UnmanagedType.LPArray)] device_list: array of cl_device_id; [MarshalAs(UnmanagedType.LPStr)] options: IntPtr; pfn_notify: Program_Callback; user_data: IntPtr): ErrorCode;
external 'opencl.dll' name 'clBuildProgram';
static function BuildProgram(&program: cl_program; num_devices: UInt32; device_list: ^cl_device_id; options: string; pfn_notify: Program_Callback; user_data: pointer): ErrorCode;
external 'opencl.dll' name 'clBuildProgram';
static function BuildProgram(&program: cl_program; num_devices: UInt32; device_list: ^cl_device_id; options: IntPtr; pfn_notify: Program_Callback; user_data: pointer): ErrorCode;
external 'opencl.dll' name 'clBuildProgram';
static function CompileProgram(&program: cl_program; num_devices: UInt32; [MarshalAs(UnmanagedType.LPArray)] device_list: array of cl_device_id; [MarshalAs(UnmanagedType.LPStr)] options: string; num_input_headers: UInt32; [MarshalAs(UnmanagedType.LPArray)] input_headers: array of cl_program; [MarshalAs(UnmanagedType.LPArray, ArraySubType = UnmanagedType.LPStr)] header_include_names: array of string; pfn_notify: Program_Callback; user_data: IntPtr): ErrorCode;
external 'opencl.dll' name 'clCompileProgram';
static function CompileProgram(&program: cl_program; num_devices: UInt32; device_list: ^cl_device_id; options: ^char; num_input_headers: UInt32; input_headers: ^cl_program; header_include_names: ^^char; pfn_notify: Program_Callback; user_data: pointer): ErrorCode;
static function CompileProgram(&program: cl_program; num_devices: UInt32; [MarshalAs(UnmanagedType.LPArray)] device_list: array of cl_device_id; [MarshalAs(UnmanagedType.LPStr)] options: IntPtr; num_input_headers: UInt32; [MarshalAs(UnmanagedType.LPArray)] input_headers: array of cl_program; [MarshalAs(UnmanagedType.LPArray, ArraySubType = UnmanagedType.LPStr)] header_include_names: array of string; pfn_notify: Program_Callback; user_data: IntPtr): ErrorCode;
external 'opencl.dll' name 'clCompileProgram';
static function CompileProgram(&program: cl_program; num_devices: UInt32; device_list: ^cl_device_id; options: string; num_input_headers: UInt32; input_headers: ^cl_program; header_include_names: ^IntPtr; pfn_notify: Program_Callback; user_data: pointer): ErrorCode;
external 'opencl.dll' name 'clCompileProgram';
static function CompileProgram(&program: cl_program; num_devices: UInt32; device_list: ^cl_device_id; options: IntPtr; num_input_headers: UInt32; input_headers: ^cl_program; header_include_names: ^IntPtr; pfn_notify: Program_Callback; user_data: pointer): ErrorCode;
external 'opencl.dll' name 'clCompileProgram';
static function LinkProgram(context: cl_context; num_devices: UInt32; [MarshalAs(UnmanagedType.LPArray)] device_list: array of cl_device_id; [MarshalAs(UnmanagedType.LPStr)] options: string; num_input_programs: UInt32; [MarshalAs(UnmanagedType.LPArray)] input_programs: array of cl_program; pfn_notify: Program_Callback; user_data: IntPtr; var errcode_ret: ErrorCode): cl_program;
external 'opencl.dll' name 'clLinkProgram';
static function LinkProgram(context: cl_context; num_devices: UInt32; device_list: ^cl_device_id; options: ^char; num_input_programs: UInt32; input_programs: ^cl_program; pfn_notify: Program_Callback; user_data: pointer; errcode_ret: ^ErrorCode): cl_program;
static function LinkProgram(context: cl_context; num_devices: UInt32; [MarshalAs(UnmanagedType.LPArray)] device_list: array of cl_device_id; [MarshalAs(UnmanagedType.LPStr)] options: IntPtr; num_input_programs: UInt32; [MarshalAs(UnmanagedType.LPArray)] input_programs: array of cl_program; pfn_notify: Program_Callback; user_data: IntPtr; var errcode_ret: ErrorCode): cl_program;
external 'opencl.dll' name 'clLinkProgram';
static function LinkProgram(context: cl_context; num_devices: UInt32; device_list: ^cl_device_id; options: string; num_input_programs: UInt32; input_programs: ^cl_program; pfn_notify: Program_Callback; user_data: pointer; errcode_ret: ^ErrorCode): cl_program;
external 'opencl.dll' name 'clLinkProgram';
static function LinkProgram(context: cl_context; num_devices: UInt32; device_list: ^cl_device_id; options: IntPtr; num_input_programs: UInt32; input_programs: ^cl_program; pfn_notify: Program_Callback; user_data: pointer; errcode_ret: ^ErrorCode): cl_program;
external 'opencl.dll' name 'clLinkProgram';
static function GetProgramInfo(&program: cl_program; param_name: ProgramInfoType; param_value_size: UIntPtr; param_value: pointer; var param_value_size_ret: UIntPtr): ErrorCode;
@ -2008,7 +2022,7 @@ type
static function CreateKernel(&program: cl_program; [MarshalAs(UnmanagedType.LPStr)] kernel_name: string; var errcode_ret: ErrorCode): cl_kernel;
external 'opencl.dll' name 'clCreateKernel';
static function CreateKernel(&program: cl_program; kernel_name: ^char; errcode_ret: ^ErrorCode): cl_kernel;
static function CreateKernel(&program: cl_program; kernel_name: IntPtr; errcode_ret: ^ErrorCode): cl_kernel;
external 'opencl.dll' name 'clCreateKernel';
static function CreateKernelsInProgram(&program: cl_program; num_kernels: UInt32; [MarshalAs(UnmanagedType.LPArray)] kernels: array of cl_kernel; var num_kernels_ret: UInt32): ErrorCode;

267
TestSuite/CompilationSamples/OpenCLABC.pas
View file

@ -28,31 +28,26 @@ uses System;
uses System.Threading.Tasks;
uses System.Runtime.InteropServices;
//ToDo CommandQueueHostFunc при создании из o: T - заполнять сразу res, а функция пусть будет nil
// - сразу минус костыли и + скорость выполнения
//ToDo клонирование очередей
// - для паралельного выполнения из разных потоков
//ToDo если контекст создан из cl_context - не удалять его
//ToDo issue компилятора:
// - #1880
// - #1881
// - #1947
// - #1952
// - #1958
// - #1981
// - #1986
type
{$region class pre def}
{$region misc class def}
Context = class;
KernelArg = class;
Kernel = class;
ProgramCode = class;
DeviceTypeFlags = OpenCL.DeviceTypeFlags;
{$endregion class pre def}
{$endregion misc class def}
{$region CommandQueue}
@ -86,19 +81,12 @@ type
public constructor(f: ()->T) :=
self.f := f;
private костыль_поле_o: T; //ToDo #1881
//ToDo #1881
// public constructor(o: T) :=
// self.f := ()->o;
public constructor(o: T);
begin
self.костыль_поле_o := o;
self.f := ()->self.костыль_поле_o;
self.res := o;
self.f := nil;
end;
private костыль_для_prev_ev: cl_event; //ToDo #1881
protected function Invoke(c: Context; cq: cl_command_queue; prev_ev: cl_event): sequence of Task; override;
public procedure Finalize; override :=
@ -454,9 +442,7 @@ type
private _device: cl_device_id;
private _context: cl_context;
public static property &Default: Context read _def_cont;
public constructor := Create(DeviceTypeFlags.GPU);
public static property &Default: Context read _def_cont write _def_cont;
static constructor :=
try
@ -464,7 +450,11 @@ type
var ec := cl.GetPlatformIDs(1,@_platform,nil);
ec.RaiseIfError;
_def_cont := new Context;
try
_def_cont := new Context;
except
_def_cont := new Context(DeviceTypeFlags.All); // если нету GPU - попытаться хотя бы для чего то его инициализировать
end;
except
on e: Exception do
@ -475,6 +465,8 @@ type
end;
end;
public constructor := Create(DeviceTypeFlags.GPU);
public constructor(dt: DeviceTypeFlags);
begin
var ec: ErrorCode;
@ -486,27 +478,51 @@ type
end;
public function SyncInvoke<T>(q: CommandQueue<T>): T;
public constructor(context: cl_context);
begin
cl.GetContextInfo(context, ContextInfoType.CL_CONTEXT_DEVICES, new UIntPtr(IntPtr.Size), @_device, nil).RaiseIfError;
_context := context;
end;
public constructor(context: cl_context; device: cl_device_id);
begin
_device := device;
_context := context;
end;
public function BeginInvoke<T>(q: CommandQueue<T>): Task<T>;
begin
var ec: ErrorCode;
var cq := cl.CreateCommandQueue(_context, _device, CommandQueuePropertyFlags.QUEUE_OUT_OF_ORDER_EXEC_MODE_ENABLE, ec);
ec.RaiseIfError;
foreach var tsk in q.Invoke(self, cq, cl_event.Zero).ToList do tsk.Wait;
if q.ev<>cl_event.Zero then cl.WaitForEvents(1, @q.ev).RaiseIfError;
var tasks := q.Invoke(self, cq, cl_event.Zero).ToArray;
cl.ReleaseCommandQueue(cq).RaiseIfError;
Result := q.res;
var костыль_для_Result: ()->T := ()-> //ToDo #1952
begin
Task.WaitAll(tasks);
if q.ev<>cl_event.Zero then cl.WaitForEvents(1, @q.ev).RaiseIfError;
cl.ReleaseCommandQueue(cq).RaiseIfError;
Result := q.res;
end;
Result := Task.Run(костыль_для_Result);
end;
public function BeginInvoke<T>(q: CommandQueue<T>): Task<T>;
// begin ToDo #1947
// Result := new Task<T>(()->self.SyncInvoke(q)); //ToDo #1952 //ToDo #1881
// Result.Start;
// end;
public function SyncInvoke<T>(q: CommandQueue<T>): T;
begin
var tsk := BeginInvoke(q);
tsk.Wait; //ToDo плавающая ошибка - на этой строчке "System.Threading.Tasks.TaskCanceledException: Отменена задача."
Result := tsk.Result;
// может там Task&<T>.Run криво вызывается... посмотреть IL
end;
public procedure Finalize; override :=
cl.ReleaseContext(_context).RaiseIfError;
if _context <> cl_context.Zero then // если было исключение при инициализации
cl.ReleaseContext(_context).RaiseIfError;
end;
@ -520,18 +536,21 @@ type
private constructor := exit;
public constructor(c: Context; params files: array of string);
public constructor(c: Context; params files_texts: array of string);
begin
var ec: ErrorCode;
self.cntxt := c;
self._program := cl.CreateProgramWithSource(c._context, files.Length, files, files.ConvertAll(s->new UIntPtr(s.Length)), ec);
self._program := cl.CreateProgramWithSource(c._context, files_texts.Length, files_texts, files_texts.ConvertAll(s->new UIntPtr(s.Length)), ec);
ec.RaiseIfError;
cl.BuildProgram(self._program, 1, @c._device, nil,nil,nil).RaiseIfError;
end;
public constructor(params files_texts: array of string) :=
Create(Context.Default, files_texts);
public property KernelByName[kname: string]: Kernel read new Kernel(self, kname); default;
public function GetAllKernels: Dictionary<string, Kernel>;
@ -621,29 +640,6 @@ function HPQ(p: ()->()): CommandQueueHostFunc<object>;
implementation
{$region Костыль #1947, #1952}
type
КостыльType1<T> = auto class //ToDo любая из: #1947, #1952
this_par: Context;
par1: CommandQueue<T>;
function lambda1: T;
begin
Result := this_par.SyncInvoke(par1);
end;
end;
function Context.BeginInvoke<T>(q: CommandQueue<T>): Task<T>;
begin
var k := new КостыльType1<T>(self,q);
Result := Task&<T>.Run(k.lambda1);
end;
{$endregion Костыль#1947, #1952}
{$region CommandQueue}
{$region HostFunc}
@ -652,18 +648,23 @@ function CommandQueueHostFunc<T>.Invoke(c: Context; cq: cl_command_queue; prev_e
begin
var ec: ErrorCode;
ClearEvent;
self.ev := cl.CreateUserEvent(c._context, ec);
ec.RaiseIfError;
костыль_для_prev_ev := prev_ev;
yield Task.Run(()->
if (prev_ev<>cl_event.Zero) or (self.f <> nil) then
begin
if костыль_для_prev_ev<>cl_event.Zero then cl.WaitForEvents(1,@костыль_для_prev_ev).RaiseIfError;
self.res := f();
cl.SetUserEventStatus(self.ev, CommandExecutionStatus.COMPLETE).RaiseIfError;
end);
ClearEvent;
self.ev := cl.CreateUserEvent(c._context, ec);
ec.RaiseIfError;
yield Task.Run(()->
begin
if prev_ev<>cl_event.Zero then cl.WaitForEvents(1,@prev_ev).RaiseIfError;
if self.f<>nil then self.res := self.f();
cl.SetUserEventStatus(self.ev, CommandExecutionStatus.COMPLETE).RaiseIfError;
end);
end else
self.ev := cl_event.Zero;
end;
@ -678,30 +679,33 @@ type
CommandQueueSyncList<T> = sealed class(CommandQueue<T>)
public lst := new List<CommandQueueBase>;
private костыль_для_prev_ev: cl_event; //ToDo #1881
protected function Invoke(c: Context; cq: cl_command_queue; prev_ev: cl_event): sequence of Task; override;
begin
var ec: ErrorCode;
ClearEvent;
self.ev := cl.CreateUserEvent(c._context, ec);
ec.RaiseIfError;
var task_lst := new List<Task>(lst.Count);
foreach var sq in lst do
begin
yield sequence sq.Invoke(c, cq, prev_ev);
prev_ev := sq.ev;
end;
костыль_для_prev_ev := prev_ev;
yield Task.Run(()->
if prev_ev<>cl_event.Zero then
begin
if костыль_для_prev_ev<>cl_event.Zero then cl.WaitForEvents(1,@костыль_для_prev_ev).RaiseIfError;
ClearEvent;
self.ev := cl.CreateUserEvent(c._context, ec);
ec.RaiseIfError;
yield Task.Run(()->
begin
cl.WaitForEvents(1,@prev_ev).RaiseIfError;
self.res := T(lst[lst.Count-1].GetRes);
cl.SetUserEventStatus(self.ev, CommandExecutionStatus.COMPLETE).RaiseIfError;
end);
end else
begin
self.ev := cl_event.Zero;
self.res := T(lst[lst.Count-1].GetRes);
cl.SetUserEventStatus(self.ev, CommandExecutionStatus.COMPLETE).RaiseIfError;
end);
end;
end;
@ -743,18 +747,15 @@ type
self.ev := cl.CreateUserEvent(c._context, ec);
ec.RaiseIfError;
var task_lst := new List<Task>(lst.Count);
foreach var sq in lst do yield sequence sq.Invoke(c, cq, prev_ev);
var p: Action0 := ()-> //ToDo #1958
yield Task.Run(()->
begin
var evs := lst.Select(q->q.ev).Where(ev->ev<>cl_event.Zero).ToArray;
if evs.Length<>0 then cl.WaitForEvents(evs.Length,evs).RaiseIfError;
self.res := T(lst[lst.Count-1].GetRes);
cl.SetUserEventStatus(self.ev, CommandExecutionStatus.COMPLETE).RaiseIfError;
end;
yield Task.Run(p);
end);
end;
@ -821,9 +822,6 @@ type
self.len := len;
end;
private костыль_для_cq: cl_event; //ToDo #1881
private костыль_для_ev_lst: List<cl_event>; //ToDo #1880
protected function Invoke(c: Context; cq: cl_command_queue; prev_ev: cl_event): sequence of Task; override;
begin
var ec: ErrorCode;
@ -839,16 +837,14 @@ type
self.ev := cl.CreateUserEvent(c._context, ec);
ec.RaiseIfError;
костыль_для_cq := cq;
костыль_для_ev_lst := ev_lst;
yield Task.Run(()->
begin
if костыль_для_ev_lst.Count<>0 then cl.WaitForEvents(костыль_для_ev_lst.Count, костыль_для_ev_lst.ToArray).RaiseIfError;
if ev_lst.Count<>0 then cl.WaitForEvents(ev_lst.Count, ev_lst.ToArray).RaiseIfError;
var buff_ev: cl_event;
if prev.ev=cl_event.Zero then
cl.EnqueueWriteBuffer(костыль_для_cq, org.memobj, 0, new UIntPtr(offset.res), new UIntPtr(len.res), ptr.res, 0,nil,@buff_ev).RaiseIfError else
cl.EnqueueWriteBuffer(костыль_для_cq, org.memobj, 0, new UIntPtr(offset.res), new UIntPtr(len.res), ptr.res, 1,@prev.ev,@buff_ev).RaiseIfError;
cl.EnqueueWriteBuffer(cq, org.memobj, 0, new UIntPtr(offset.res), new UIntPtr(len.res), ptr.res, 0,nil,@buff_ev).RaiseIfError else
cl.EnqueueWriteBuffer(cq, org.memobj, 0, new UIntPtr(offset.res), new UIntPtr(len.res), ptr.res, 1,@prev.ev,@buff_ev).RaiseIfError;
cl.WaitForEvents(1, @buff_ev).RaiseIfError;
cl.SetUserEventStatus(self.ev, CommandExecutionStatus.COMPLETE).RaiseIfError;
@ -875,9 +871,6 @@ type
self.len := len;
end;
private костыль_для_cq: cl_event; //ToDo #1881
private костыль_для_ev_lst: List<cl_event>; //ToDo #1880
protected function Invoke(c: Context; cq: cl_command_queue; prev_ev: cl_event): sequence of Task; override;
begin
var ev_lst := new List<cl_event>;
@ -893,19 +886,17 @@ type
self.ev := cl.CreateUserEvent(c._context, ec);
ec.RaiseIfError;
костыль_для_cq := cq;
костыль_для_ev_lst := ev_lst;
yield Task.Run(()->
begin
if a.ev<>cl_event.Zero then cl.WaitForEvents(1,@a.ev).RaiseIfError;
var gchnd := GCHandle.Alloc(a.res, GCHandleType.Pinned);
if костыль_для_ev_lst.Count<>0 then cl.WaitForEvents(костыль_для_ev_lst.Count, костыль_для_ev_lst.ToArray).RaiseIfError;
if ev_lst.Count<>0 then cl.WaitForEvents(ev_lst.Count, ev_lst.ToArray).RaiseIfError;
var buff_ev: cl_event;
if prev.ev=cl_event.Zero then
cl.EnqueueWriteBuffer(костыль_для_cq, org.memobj, 0, new UIntPtr(offset.res), new UIntPtr(len.res), gchnd.AddrOfPinnedObject, 0,nil,@buff_ev).RaiseIfError else
cl.EnqueueWriteBuffer(костыль_для_cq, org.memobj, 0, new UIntPtr(offset.res), new UIntPtr(len.res), gchnd.AddrOfPinnedObject, 1,@prev.ev,@buff_ev).RaiseIfError;
cl.EnqueueWriteBuffer(cq, org.memobj, 0, new UIntPtr(offset.res), new UIntPtr(len.res), gchnd.AddrOfPinnedObject, 0,nil,@buff_ev).RaiseIfError else
cl.EnqueueWriteBuffer(cq, org.memobj, 0, new UIntPtr(offset.res), new UIntPtr(len.res), gchnd.AddrOfPinnedObject, 1,@prev.ev,@buff_ev).RaiseIfError;
cl.WaitForEvents(1,@buff_ev).RaiseIfError;
cl.SetUserEventStatus(self.ev, CommandExecutionStatus.COMPLETE).RaiseIfError;
@ -948,9 +939,6 @@ type
self.len := len;
end;
private костыль_для_cq: cl_event; //ToDo #1881
private костыль_для_ev_lst: List<cl_event>; //ToDo #1880
protected function Invoke(c: Context; cq: cl_command_queue; prev_ev: cl_event): sequence of Task; override;
begin
var ec: ErrorCode;
@ -966,16 +954,14 @@ type
self.ev := cl.CreateUserEvent(c._context, ec);
ec.RaiseIfError;
костыль_для_cq := cq;
костыль_для_ev_lst := ev_lst;
yield Task.Run(()->
begin
if костыль_для_ev_lst.Count<>0 then cl.WaitForEvents(костыль_для_ev_lst.Count, костыль_для_ev_lst.ToArray).RaiseIfError;
if ev_lst.Count<>0 then cl.WaitForEvents(ev_lst.Count, ev_lst.ToArray).RaiseIfError;
var buff_ev: cl_event;
if prev.ev=cl_event.Zero then
cl.EnqueueReadBuffer(костыль_для_cq, org.memobj, 0, new UIntPtr(offset.res), new UIntPtr(len.res), ptr.res, 0,nil,@buff_ev).RaiseIfError else
cl.EnqueueReadBuffer(костыль_для_cq, org.memobj, 0, new UIntPtr(offset.res), new UIntPtr(len.res), ptr.res, 1,@prev.ev,@buff_ev).RaiseIfError;
cl.EnqueueReadBuffer(cq, org.memobj, 0, new UIntPtr(offset.res), new UIntPtr(len.res), ptr.res, 0,nil,@buff_ev).RaiseIfError else
cl.EnqueueReadBuffer(cq, org.memobj, 0, new UIntPtr(offset.res), new UIntPtr(len.res), ptr.res, 1,@prev.ev,@buff_ev).RaiseIfError;
cl.WaitForEvents(1, @buff_ev).RaiseIfError;
cl.SetUserEventStatus(self.ev, CommandExecutionStatus.COMPLETE).RaiseIfError;
@ -1002,9 +988,6 @@ type
self.len := len;
end;
private костыль_для_cq: cl_event; //ToDo #1881
private костыль_для_ev_lst: List<cl_event>; //ToDo #1880
protected function Invoke(c: Context; cq: cl_command_queue; prev_ev: cl_event): sequence of Task; override;
begin
var ev_lst := new List<cl_event>;
@ -1020,19 +1003,17 @@ type
self.ev := cl.CreateUserEvent(c._context, ec);
ec.RaiseIfError;
костыль_для_cq := cq;
костыль_для_ev_lst := ev_lst;
yield Task.Run(()->
begin
if a.ev<>cl_event.Zero then cl.WaitForEvents(1,@a.ev).RaiseIfError;
var gchnd := GCHandle.Alloc(a.res, GCHandleType.Pinned);
if костыль_для_ev_lst.Count<>0 then cl.WaitForEvents(костыль_для_ev_lst.Count, костыль_для_ev_lst.ToArray).RaiseIfError;
if ev_lst.Count<>0 then cl.WaitForEvents(ev_lst.Count, ev_lst.ToArray).RaiseIfError;
var buff_ev: cl_event;
if prev.ev=cl_event.Zero then
cl.EnqueueReadBuffer(костыль_для_cq, org.memobj, 0, new UIntPtr(offset.res), new UIntPtr(len.res), gchnd.AddrOfPinnedObject, 0,nil,@buff_ev).RaiseIfError else
cl.EnqueueReadBuffer(костыль_для_cq, org.memobj, 0, new UIntPtr(offset.res), new UIntPtr(len.res), gchnd.AddrOfPinnedObject, 1,@prev.ev,@buff_ev).RaiseIfError;
cl.EnqueueReadBuffer(cq, org.memobj, 0, new UIntPtr(offset.res), new UIntPtr(len.res), gchnd.AddrOfPinnedObject, 0,nil,@buff_ev).RaiseIfError else
cl.EnqueueReadBuffer(cq, org.memobj, 0, new UIntPtr(offset.res), new UIntPtr(len.res), gchnd.AddrOfPinnedObject, 1,@prev.ev,@buff_ev).RaiseIfError;
cl.WaitForEvents(1,@buff_ev).RaiseIfError;
cl.SetUserEventStatus(self.ev, CommandExecutionStatus.COMPLETE).RaiseIfError;
@ -1076,9 +1057,6 @@ type
self.len := len;
end;
private костыль_для_cq: cl_event; //ToDo #1881
private костыль_для_ev_lst: List<cl_event>; //ToDo #1880
protected function Invoke(c: Context; cq: cl_command_queue; prev_ev: cl_event): sequence of Task; override;
begin
var ec: ErrorCode;
@ -1095,16 +1073,14 @@ type
self.ev := cl.CreateUserEvent(c._context, ec);
ec.RaiseIfError;
костыль_для_cq := cq;
костыль_для_ev_lst := ev_lst;
yield Task.Run(()->
begin
if костыль_для_ev_lst.Count<>0 then cl.WaitForEvents(костыль_для_ev_lst.Count, костыль_для_ev_lst.ToArray).RaiseIfError;
if ev_lst.Count<>0 then cl.WaitForEvents(ev_lst.Count, ev_lst.ToArray).RaiseIfError;
var buff_ev: cl_event;
if prev.ev=cl_event.Zero then
cl.EnqueueFillBuffer(костыль_для_cq, org.memobj, ptr.res,new UIntPtr(pattern_len.res), new UIntPtr(offset.res),new UIntPtr(len.res), 0,nil,@buff_ev).RaiseIfError else
cl.EnqueueFillBuffer(костыль_для_cq, org.memobj, ptr.res,new UIntPtr(pattern_len.res), new UIntPtr(offset.res),new UIntPtr(len.res), 1,@prev.ev,@buff_ev).RaiseIfError;
cl.EnqueueFillBuffer(cq, org.memobj, ptr.res,new UIntPtr(pattern_len.res), new UIntPtr(offset.res),new UIntPtr(len.res), 0,nil,@buff_ev).RaiseIfError else
cl.EnqueueFillBuffer(cq, org.memobj, ptr.res,new UIntPtr(pattern_len.res), new UIntPtr(offset.res),new UIntPtr(len.res), 1,@prev.ev,@buff_ev).RaiseIfError;
cl.WaitForEvents(1, @buff_ev).RaiseIfError;
cl.SetUserEventStatus(self.ev, CommandExecutionStatus.COMPLETE).RaiseIfError;
@ -1131,9 +1107,6 @@ type
self.len := len;
end;
private костыль_для_cq: cl_event; //ToDo #1881
private костыль_для_ev_lst: List<cl_event>; //ToDo #1880
protected function Invoke(c: Context; cq: cl_command_queue; prev_ev: cl_event): sequence of Task; override;
begin
var ev_lst := new List<cl_event>;
@ -1149,20 +1122,18 @@ type
self.ev := cl.CreateUserEvent(c._context, ec);
ec.RaiseIfError;
костыль_для_cq := cq;
костыль_для_ev_lst := ev_lst;
yield Task.Run(()->
begin
if a.ev<>cl_event.Zero then cl.WaitForEvents(1,@a.ev).RaiseIfError;
var gchnd := GCHandle.Alloc(a.res, GCHandleType.Pinned);
var pattern_sz := Marshal.SizeOf(a.res.GetType.GetElementType) * a.res.Length;
if костыль_для_ev_lst.Count<>0 then cl.WaitForEvents(костыль_для_ev_lst.Count, костыль_для_ev_lst.ToArray).RaiseIfError;
if ev_lst.Count<>0 then cl.WaitForEvents(ev_lst.Count, ev_lst.ToArray).RaiseIfError;
var buff_ev: cl_event;
if prev.ev=cl_event.Zero then
cl.EnqueueFillBuffer(костыль_для_cq, org.memobj, gchnd.AddrOfPinnedObject,new UIntPtr(pattern_sz), new UIntPtr(offset.res),new UIntPtr(len.res), 0,nil,@buff_ev).RaiseIfError else
cl.EnqueueFillBuffer(костыль_для_cq, org.memobj, gchnd.AddrOfPinnedObject,new UIntPtr(pattern_sz), new UIntPtr(offset.res),new UIntPtr(len.res), 1,@prev.ev,@buff_ev).RaiseIfError;
cl.EnqueueFillBuffer(cq, org.memobj, gchnd.AddrOfPinnedObject,new UIntPtr(pattern_sz), new UIntPtr(offset.res),new UIntPtr(len.res), 0,nil,@buff_ev).RaiseIfError else
cl.EnqueueFillBuffer(cq, org.memobj, gchnd.AddrOfPinnedObject,new UIntPtr(pattern_sz), new UIntPtr(offset.res),new UIntPtr(len.res), 1,@prev.ev,@buff_ev).RaiseIfError;
cl.WaitForEvents(1,@buff_ev).RaiseIfError;
cl.SetUserEventStatus(self.ev, CommandExecutionStatus.COMPLETE).RaiseIfError;
@ -1207,9 +1178,6 @@ type
self.len := len;
end;
private костыль_для_cq: cl_event; //ToDo #1881
private костыль_для_ev_lst: List<cl_event>; //ToDo #1880
protected function Invoke(c: Context; cq: cl_command_queue; prev_ev: cl_event): sequence of Task; override;
begin
var ec: ErrorCode;
@ -1227,16 +1195,14 @@ type
self.ev := cl.CreateUserEvent(c._context, ec);
ec.RaiseIfError;
костыль_для_cq := cq;
костыль_для_ev_lst := ev_lst;
yield Task.Run(()->
begin
if костыль_для_ev_lst.Count<>0 then cl.WaitForEvents(костыль_для_ev_lst.Count, костыль_для_ev_lst.ToArray).RaiseIfError;
if ev_lst.Count<>0 then cl.WaitForEvents(ev_lst.Count, ev_lst.ToArray).RaiseIfError;
var buff_ev: cl_event;
if prev.ev=cl_event.Zero then
cl.EnqueueCopyBuffer(костыль_для_cq, f_arg.res.memobj,t_arg.res.memobj, new UIntPtr(f_pos.res),new UIntPtr(t_pos.res), new UIntPtr(len.res), 0,nil,@buff_ev).RaiseIfError else
cl.EnqueueCopyBuffer(костыль_для_cq, f_arg.res.memobj,t_arg.res.memobj, new UIntPtr(f_pos.res),new UIntPtr(t_pos.res), new UIntPtr(len.res), 1,@prev.ev,@buff_ev).RaiseIfError;
cl.EnqueueCopyBuffer(cq, f_arg.res.memobj,t_arg.res.memobj, new UIntPtr(f_pos.res),new UIntPtr(t_pos.res), new UIntPtr(len.res), 0,nil,@buff_ev).RaiseIfError else
cl.EnqueueCopyBuffer(cq, f_arg.res.memobj,t_arg.res.memobj, new UIntPtr(f_pos.res),new UIntPtr(t_pos.res), new UIntPtr(len.res), 1,@prev.ev,@buff_ev).RaiseIfError;
cl.WaitForEvents(1, @buff_ev).RaiseIfError;
cl.SetUserEventStatus(self.ev, CommandExecutionStatus.COMPLETE).RaiseIfError;
@ -1305,10 +1271,6 @@ type
self.args_q := args;
end;
private костыль_для_c: Context; //ToDo #1881
private костыль_для_cq: cl_event; //ToDo #1881
private костыль_для_ev_lst: List<cl_event>; //ToDo #1880
protected function Invoke(c: Context; cq: cl_command_queue; prev_ev: cl_event): sequence of Task; override;
begin
var ev_lst := new List<cl_event>;
@ -1329,21 +1291,18 @@ type
self.ev := cl.CreateUserEvent(c._context, ec);
ec.RaiseIfError;
костыль_для_c := c;
костыль_для_cq := cq;
костыль_для_ev_lst := ev_lst;
yield Task.Run(()->
begin
if костыль_для_ev_lst.Count<>0 then cl.WaitForEvents(костыль_для_ev_lst.Count,костыль_для_ev_lst.ToArray);
if ev_lst.Count<>0 then cl.WaitForEvents(ev_lst.Count,ev_lst.ToArray);
for var i := 0 to args_q.Length-1 do
begin
if args_q[i].res.memobj=cl_mem.Zero then args_q[i].res.Init(костыль_для_c);
if args_q[i].res.memobj=cl_mem.Zero then args_q[i].res.Init(c);
cl.SetKernelArg(org._kernel, i, new UIntPtr(UIntPtr.Size), args_q[i].res.memobj).RaiseIfError;
end;
var kernel_ev: cl_event;
cl.EnqueueNDRangeKernel(костыль_для_cq, org._kernel, work_szs.Length, nil,work_szs,nil, 0,nil,@kernel_ev).RaiseIfError; // prev.ev уже в ev_lst, тут проверять не надо
cl.EnqueueNDRangeKernel(cq, org._kernel, work_szs.Length, nil,work_szs,nil, 0,nil,@kernel_ev).RaiseIfError; // prev.ev уже в ev_lst, тут проверять не надо
cl.WaitForEvents(1,@kernel_ev).RaiseIfError;
cl.SetUserEventStatus(self.ev, CommandExecutionStatus.COMPLETE).RaiseIfError;
@ -1465,9 +1424,7 @@ begin
szs_val
));
//ToDo #1986
// var res_len := Result.Length;
var res_len := szs_val.Aggregate((i1,i2)->i1*i2);
var res_len := Result.Length;
Context.Default.SyncInvoke(
self.NewQueue

26749
TestSuite/CompilationSamples/OpenGL.pas
View file

File diff suppressed because it is too large Load diff

14
TestSuite/CompilationSamples/OpenGLABC.pas Normal file
View file

@ -0,0 +1,14 @@
unit OpenGLABC;
interface
uses OpenGL;
implementation
begin
Writeln('OpenGLABC');
Writeln(new System.NotImplementedException);
Readln;
Halt;
end.

106
TreeConverter/TreeConversion/convertion_data_and_alghoritms.cs
View file

@ -1795,6 +1795,51 @@ namespace PascalABCCompiler.TreeConverter
}
}
private void delete_functions_with_less_result_type(List<function_node> set_of_possible_functions)
{
function_node best_function = null;
List<function_node> to_remove = new List<function_node>();
foreach (function_node fn in set_of_possible_functions)
{
if (fn.return_value_type != null)
{
if (best_function == null)
{
best_function = fn;
}
else
{
type_compare tc = type_table.compare_types(best_function.return_value_type, fn.return_value_type);
if (best_function.return_value_type.is_standard_type && fn.return_value_type.is_standard_type)
{
if (tc == type_compare.less_type)
{
to_remove.Add(best_function);
best_function = fn;
}
else if (tc == type_compare.greater_type)
to_remove.Add(fn);
}
else
{
if (tc == type_compare.greater_type)
{
to_remove.Add(best_function);
best_function = fn;
}
else if (tc == type_compare.less_type)
to_remove.Add(fn);
}
}
}
}
foreach (function_node fn in to_remove)
{
set_of_possible_functions.Remove(fn);
}
}
//Первый параметр - выходной. Он содержит выражения с необходимыми преобразованиями типов.
public function_node select_function(expressions_list parameters, List<SymbolInfo> functions, location loc, List<SyntaxTree.expression> syntax_nodes_parameters = null, bool only_from_not_extensions = false)
@ -2112,47 +2157,9 @@ namespace PascalABCCompiler.TreeConverter
return new indefinite_functions_set(indefinits);
}
function_node best_function = null;
List<function_node> to_remove = new List<function_node>();
foreach (function_node fn in set_of_possible_functions)
{
if (fn.return_value_type != null)
{
if (best_function == null)
{
best_function = fn;
}
else
{
type_compare tc = type_table.compare_types(best_function.return_value_type, fn.return_value_type);
if (best_function.return_value_type.is_standard_type && fn.return_value_type.is_standard_type)
{
if (tc == type_compare.less_type)
{
to_remove.Add(best_function);
best_function = fn;
}
else if (tc == type_compare.greater_type)
to_remove.Add(fn);
}
else
{
if (tc == type_compare.greater_type)
{
to_remove.Add(best_function);
best_function = fn;
}
else if (tc == type_compare.less_type)
to_remove.Add(fn);
}
}
}
}
foreach (function_node fn in to_remove)
{
set_of_possible_functions.Remove(fn);
}
// Удалить функции, у которых тип возвращаемого значения меньше.
// Тут это ошибка т.к. параметры могут соответствовать точнее, а они проверяются дальше. Приоритет должен даваться параметрам
//delete_functions_with_less_result_type(set_of_possible_functions);
// Формирование словаря списков функций с одинаковым значением расстояния
// SSM 07/11/17 Для a.Average(x->x) - остаётся 4 функции. На этом уровне выбрать невозможно:
@ -2167,7 +2174,12 @@ namespace PascalABCCompiler.TreeConverter
int distance = 0;
for (int i = 0; i < parameters.Count; i++)
{
type_node from = parameters[i].type;
//type_node from = parameters[i].type;
expression_node en = parameters[i];
syntax_tree_visitor.try_convert_typed_expression_to_function_call(ref en);
type_node from = en.type;
type_node to = fn.parameters[Math.Min(i, fn.parameters.Count - 1)].type;
if (fn.parameters[Math.Min(i, fn.parameters.Count - 1)].is_params)
to = to.element_type;
@ -2204,6 +2216,12 @@ namespace PascalABCCompiler.TreeConverter
// если две и больше - то они пробрасываются и мы переходим к бОльшей дистанции
{
List<function_node> funcs = distances[dist];
// Удалить функции, у которых тип возвращаемого значения меньше.
// Тут это ошибка т.к. параметры могут соответствовать точнее, а они проверяются дальше. Приоритет должен даваться параметрам
// SSM 27.07.19 перенес это сюда чтобы удаление происходило среди функций с одной дистанцией. В строке 2162 закомментировал
delete_functions_with_less_result_type(funcs);
if (funcs.Count == 1) // если для данной дистанции ровно одна функция, то обработать её и вернуть
{
Errors.Error err = null;
@ -2292,7 +2310,6 @@ namespace PascalABCCompiler.TreeConverter
if (!fldiResType.Equals(kres[n]))
bools[n] = false;
}
//var rettype_i =
}
// SSM 04.06.19
@ -2439,6 +2456,7 @@ namespace PascalABCCompiler.TreeConverter
}
}
return AddError<function_node>(new SeveralFunctionsCanBeCalled(loc, set_of_possible_functions));
}
@ -2446,6 +2464,8 @@ namespace PascalABCCompiler.TreeConverter
{
if (from == to)
return 0;
if (from is short_string_type_node && to is compiled_type_node ctn && ctn.compiled_type == typeof(System.String))
return 0;
if (from is delegated_methods && (from as delegated_methods).empty_param_method != null && (from as delegated_methods).empty_param_method.ret_type != null)
from = (from as delegated_methods).empty_param_method.ret_type;
if (to is delegated_methods && (to as delegated_methods).empty_param_method != null && (to as delegated_methods).empty_param_method.ret_type != null)

2
TreeConverter/TreeConversion/syntax_tree_visitor.cs
View file

@ -9337,7 +9337,7 @@ namespace PascalABCCompiler.TreeConverter
return bfc;
}
private void try_convert_typed_expression_to_function_call(ref expression_node en)
public void try_convert_typed_expression_to_function_call(ref expression_node en)
{
if (en.semantic_node_type == semantic_node_type.typed_expression)
{