Skip to content

Commit

Permalink
Delete extra enq_ev when ev_l2.HasError
Browse files Browse the repository at this point in the history
  • Loading branch information
SunSerega committed Oct 17, 2023
1 parent e61e2fe commit a25cfa8
Show file tree
Hide file tree
Showing 4 changed files with 106 additions and 63 deletions.
55 changes: 35 additions & 20 deletions Modules.Packed/OpenCLABC.pas
Original file line number Diff line number Diff line change
Expand Up @@ -8978,27 +8978,22 @@ EventList = record

{$region Event status}

{$ifdef DEBUG}
public static function GetStatus(ev: cl_event): clCommandExecutionStatus;
private static function GetStatus(ev: cl_event): clCommandExecutionStatus;
begin
{$ifdef EventDebug}
EventDebug.VerifyExists(ev, $'checking event status');
{$endif EventDebug}
OpenCLABCInternalException.RaiseIfError(
cl.GetEventInfo_EVENT_COMMAND_EXECUTION_STATUS(ev, Result, false)
);
end;
{$endif DEBUG}

{$ifdef DEBUG}
public static function HasCompleted(ev: cl_event): boolean;
begin
{$ifdef EventDebug}
EventDebug.VerifyExists(ev, $'checking event status');
{$endif EventDebug}
var st := GetStatus(ev);
Result := (st=clCommandExecutionStatus.COMPLETE) or (st.val<0);
Result := (st=clCommandExecutionStatus.COMPLETE) or st.IS_ERROR;
end;
{$endif DEBUG}

{$ifdef DEBUG}
public function HasCompleted: boolean;
begin
Result := false;
Expand All @@ -9009,6 +9004,16 @@ EventList = record
end;
{$endif DEBUG}

public static function HasError(ev: cl_event) := GetStatus(ev).IS_ERROR;
public function HasError: boolean;
begin
Result := true;
for var i := 0 to count-1 do
if HasError(evs[i]) then
exit;
Result := false;
end;

{$endregion Event status}

end;
Expand Down Expand Up @@ -17709,14 +17714,24 @@ CLKernelArgPrivateCommon<TInp> = record
end;

var (enq_ev, act) := direct_enq_res;
Result.Item2 := act;

// NVidia implementation doesn't create event if ev_l2.HasError
if enq_ev=cl_event.Zero then exit;
// Optimize the same way for the rest of implementations
// Also makes sure the debug event count is the same for all vendors
if EventList.HasError(enq_ev) or ev_l2.HasError then
begin
cl.ReleaseEvent(enq_ev).RaiseIfError;
exit;
end;

{$ifdef EventDebug}
EventDebug.RegisterEventRetain(enq_ev, $'Enq by {TypeName(q)}, waiting on [{ev_l2.evs?.JoinToString}]');
EventDebug.RegisterEventRetain(enq_ev, $'Enq by {TypeName(q)}, waiting on: {ev_l2.evs?.JoinToString}');
{$endif EventDebug}
// 1. ev_l2 can only be released after executing dependant command
// 2. If event in ev_l2 would complete with error, enq_ev would have non-descriptive error code
Result := new EnqRes(ev_l2+enq_ev, act);
Result.Item1 := ev_l2 + enq_ev;
end;

public [MethodImpl(MethodImplOptions.AggressiveInlining)]
Expand Down Expand Up @@ -17775,11 +17790,11 @@ CLKernelArgPrivateCommon<TInp> = record

ev_l1.MultiAttachCallback(()->
begin
var (enq_ev, enq_act) := ExecuteEnqFunc(get_o(), cq, ev_l2, enq_f, l1_err_handler,l2_err_handler{$ifdef DEBUG}, err_test_reason{$endif DEBUG}{$ifdef EventDebug}, q{$endif});
var (enq_ev, post_enq_act) := ExecuteEnqFunc(get_o(), cq, ev_l2, enq_f, l1_err_handler,l2_err_handler{$ifdef DEBUG}, err_test_reason{$endif DEBUG}{$ifdef EventDebug}, q{$endif});
OpenCLABCInternalException.RaiseIfError( cl.Flush(cq) );
enq_ev.MultiAttachCallback(()->
begin
if enq_act<>nil then enq_act(g.c);
if post_enq_act<>nil then post_enq_act(g.c);
g.ReturnCQ(cq);
res_ev.SetComplete(l2_err_handler.HadError);
end{$ifdef EventDebug}, $'propagating Enq ev of {TypeName(q)} to res_ev: {res_ev.uev}'{$endif});
Expand Down Expand Up @@ -17825,14 +17840,14 @@ CLKernelArgPrivateCommon<TInp> = record
o_const := prev_qr.IsConst;
end;

var (enq_ev, enq_act) := EnqueueableCore.Invoke(
var (enq_ev, post_enq_act) := EnqueueableCore.Invoke(
self.ExpectedEnqCount, o_const, get_o, g, l,
InvokeParams, ProcessError
{$ifdef DEBUG},self{$endif}
);

Result := new QueueResNil(enq_ev);
if enq_act<>nil then Result.AddAction(enq_act);
if post_enq_act<>nil then Result.AddAction(post_enq_act);
end;

end;
Expand Down Expand Up @@ -18037,7 +18052,7 @@ ExecCommandCLKernelCache = record
//TODO Надо ли "()->" перед arg_cache? Разница в том что:
// - Без "()->" его будет читать прямо перед вызовом InvokeParams
// - А сейчас его считает аж в EnqFunc<cl_kernel>
var (enq_ev, enq_act) := EnqueueableCore.Invoke(
var (enq_ev, post_enq_act) := EnqueueableCore.Invoke(
self.ExpectedEnqCount+args_non_const_c, k_const, get_k_ntv, g, l,
(enq_c, o_const, g, enq_evs)->
InvokeParams(enq_c, o_const, g, enq_evs, ()->arg_cache),
Expand All @@ -18046,7 +18061,7 @@ ExecCommandCLKernelCache = record
);

Result := new QueueResNil(enq_ev);
if enq_act<>nil then Result.AddAction(enq_act);
if post_enq_act<>nil then Result.AddAction(post_enq_act);
end;

protected procedure Finalize; override :=
Expand Down Expand Up @@ -18082,7 +18097,7 @@ ExecCommandCLKernelCache = record
var inp_const := prev_qr.IsConst;
l := prev_qr.TakeBaseOut;

var (enq_ev, enq_act) := EnqueueableCore.Invoke(
var (enq_ev, post_enq_act) := EnqueueableCore.Invoke(
self.ExpectedEnqCount, inp_const, prev_qr.GetResDirect, g, l,
(enq_c, o_const, g, enq_evs)->
InvokeParams(enq_c, o_const, g, enq_evs, qr),
Expand All @@ -18091,7 +18106,7 @@ ExecCommandCLKernelCache = record
);

Result := new CLTaskLocalData(enq_ev);
if enq_act<>nil then Result.prev_delegate.AddAction(enq_act);
if post_enq_act<>nil then Result.prev_delegate.AddAction(post_enq_act);
end);
end;

Expand Down
55 changes: 35 additions & 20 deletions Modules/OpenCLABC.pas
Original file line number Diff line number Diff line change
Expand Up @@ -4042,27 +4042,22 @@ EventList = record

{$region Event status}

{$ifdef DEBUG}
public static function GetStatus(ev: cl_event): clCommandExecutionStatus;
private static function GetStatus(ev: cl_event): clCommandExecutionStatus;
begin
{$ifdef EventDebug}
EventDebug.VerifyExists(ev, $'checking event status');
{$endif EventDebug}
OpenCLABCInternalException.RaiseIfError(
cl.GetEventInfo_EVENT_COMMAND_EXECUTION_STATUS(ev, Result, false)
);
end;
{$endif DEBUG}

{$ifdef DEBUG}
public static function HasCompleted(ev: cl_event): boolean;
begin
{$ifdef EventDebug}
EventDebug.VerifyExists(ev, $'checking event status');
{$endif EventDebug}
var st := GetStatus(ev);
Result := (st=clCommandExecutionStatus.COMPLETE) or (st.val<0);
Result := (st=clCommandExecutionStatus.COMPLETE) or st.IS_ERROR;
end;
{$endif DEBUG}

{$ifdef DEBUG}
public function HasCompleted: boolean;
begin
Result := false;
Expand All @@ -4073,6 +4068,16 @@ EventList = record
end;
{$endif DEBUG}

public static function HasError(ev: cl_event) := GetStatus(ev).IS_ERROR;
public function HasError: boolean;
begin
Result := true;
for var i := 0 to count-1 do
if HasError(evs[i]) then
exit;
Result := false;
end;

{$endregion Event status}

end;
Expand Down Expand Up @@ -9138,14 +9143,24 @@ CLKernelArgPrivateCommon<TInp> = record
end;

var (enq_ev, act) := direct_enq_res;
Result.Item2 := act;

// NVidia implementation doesn't create event if ev_l2.HasError
if enq_ev=cl_event.Zero then exit;
// Optimize the same way for the rest of implementations
// Also makes sure the debug event count is the same for all vendors
if EventList.HasError(enq_ev) or ev_l2.HasError then
begin
cl.ReleaseEvent(enq_ev).RaiseIfError;
exit;
end;

{$ifdef EventDebug}
EventDebug.RegisterEventRetain(enq_ev, $'Enq by {TypeName(q)}, waiting on [{ev_l2.evs?.JoinToString}]');
EventDebug.RegisterEventRetain(enq_ev, $'Enq by {TypeName(q)}, waiting on: {ev_l2.evs?.JoinToString}');
{$endif EventDebug}
// 1. ev_l2 can only be released after executing dependant command
// 2. If event in ev_l2 would complete with error, enq_ev would have non-descriptive error code
Result := new EnqRes(ev_l2+enq_ev, act);
Result.Item1 := ev_l2 + enq_ev;
end;

public [MethodImpl(MethodImplOptions.AggressiveInlining)]
Expand Down Expand Up @@ -9204,11 +9219,11 @@ CLKernelArgPrivateCommon<TInp> = record

ev_l1.MultiAttachCallback(()->
begin
var (enq_ev, enq_act) := ExecuteEnqFunc(get_o(), cq, ev_l2, enq_f, l1_err_handler,l2_err_handler{$ifdef DEBUG}, err_test_reason{$endif DEBUG}{$ifdef EventDebug}, q{$endif});
var (enq_ev, post_enq_act) := ExecuteEnqFunc(get_o(), cq, ev_l2, enq_f, l1_err_handler,l2_err_handler{$ifdef DEBUG}, err_test_reason{$endif DEBUG}{$ifdef EventDebug}, q{$endif});
OpenCLABCInternalException.RaiseIfError( cl.Flush(cq) );
enq_ev.MultiAttachCallback(()->
begin
if enq_act<>nil then enq_act(g.c);
if post_enq_act<>nil then post_enq_act(g.c);
g.ReturnCQ(cq);
res_ev.SetComplete(l2_err_handler.HadError);
end{$ifdef EventDebug}, $'propagating Enq ev of {TypeName(q)} to res_ev: {res_ev.uev}'{$endif});
Expand Down Expand Up @@ -9254,14 +9269,14 @@ CLKernelArgPrivateCommon<TInp> = record
o_const := prev_qr.IsConst;
end;

var (enq_ev, enq_act) := EnqueueableCore.Invoke(
var (enq_ev, post_enq_act) := EnqueueableCore.Invoke(
self.ExpectedEnqCount, o_const, get_o, g, l,
InvokeParams, ProcessError
{$ifdef DEBUG},self{$endif}
);

Result := new QueueResNil(enq_ev);
if enq_act<>nil then Result.AddAction(enq_act);
if post_enq_act<>nil then Result.AddAction(post_enq_act);
end;

end;
Expand Down Expand Up @@ -9466,7 +9481,7 @@ ExecCommandCLKernelCache = record
//TODO Надо ли "()->" перед arg_cache? Разница в том что:
// - Без "()->" его будет читать прямо перед вызовом InvokeParams
// - А сейчас его считает аж в EnqFunc<cl_kernel>
var (enq_ev, enq_act) := EnqueueableCore.Invoke(
var (enq_ev, post_enq_act) := EnqueueableCore.Invoke(
self.ExpectedEnqCount+args_non_const_c, k_const, get_k_ntv, g, l,
(enq_c, o_const, g, enq_evs)->
InvokeParams(enq_c, o_const, g, enq_evs, ()->arg_cache),
Expand All @@ -9475,7 +9490,7 @@ ExecCommandCLKernelCache = record
);

Result := new QueueResNil(enq_ev);
if enq_act<>nil then Result.AddAction(enq_act);
if post_enq_act<>nil then Result.AddAction(post_enq_act);
end;

protected procedure Finalize; override :=
Expand Down Expand Up @@ -9511,7 +9526,7 @@ ExecCommandCLKernelCache = record
var inp_const := prev_qr.IsConst;
l := prev_qr.TakeBaseOut;

var (enq_ev, enq_act) := EnqueueableCore.Invoke(
var (enq_ev, post_enq_act) := EnqueueableCore.Invoke(
self.ExpectedEnqCount, inp_const, prev_qr.GetResDirect, g, l,
(enq_c, o_const, g, enq_evs)->
InvokeParams(enq_c, o_const, g, enq_evs, qr),
Expand All @@ -9520,7 +9535,7 @@ ExecCommandCLKernelCache = record
);

Result := new CLTaskLocalData(enq_ev);
if enq_act<>nil then Result.prev_delegate.AddAction(enq_act);
if post_enq_act<>nil then Result.prev_delegate.AddAction(post_enq_act);
end);
end;

Expand Down
Loading

0 comments on commit a25cfa8

Please sign in to comment.