From a25cfa841bfe48d30c4503b3a31cbfc993dfc0e2 Mon Sep 17 00:00:00 2001 From: Sun Serega Date: Tue, 17 Oct 2023 17:22:26 +0300 Subject: [PATCH] Delete extra enq_ev when ev_l2.HasError --- Modules.Packed/OpenCLABC.pas | 55 ++++++++++++------- Modules/OpenCLABC.pas | 55 ++++++++++++------- Packing/Descriptions/OpenCLABC.predoc | 55 ++++++++++++------- .../11#Finally+Handle/BranchUnCancel.pas" | 4 +- 4 files changed, 106 insertions(+), 63 deletions(-) diff --git a/Modules.Packed/OpenCLABC.pas b/Modules.Packed/OpenCLABC.pas index 742b8b9f..6c2d0fab 100644 --- a/Modules.Packed/OpenCLABC.pas +++ b/Modules.Packed/OpenCLABC.pas @@ -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; @@ -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; @@ -17709,14 +17714,24 @@ CLKernelArgPrivateCommon = 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)] @@ -17775,11 +17790,11 @@ CLKernelArgPrivateCommon = 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}); @@ -17825,14 +17840,14 @@ CLKernelArgPrivateCommon = 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; @@ -18037,7 +18052,7 @@ ExecCommandCLKernelCache = record //TODO Надо ли "()->" перед arg_cache? Разница в том что: // - Без "()->" его будет читать прямо перед вызовом InvokeParams // - А сейчас его считает аж в EnqFunc - 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), @@ -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 := @@ -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), @@ -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; diff --git a/Modules/OpenCLABC.pas b/Modules/OpenCLABC.pas index c0c877bf..2cc5d50f 100644 --- a/Modules/OpenCLABC.pas +++ b/Modules/OpenCLABC.pas @@ -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; @@ -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; @@ -9138,14 +9143,24 @@ CLKernelArgPrivateCommon = 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)] @@ -9204,11 +9219,11 @@ CLKernelArgPrivateCommon = 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}); @@ -9254,14 +9269,14 @@ CLKernelArgPrivateCommon = 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; @@ -9466,7 +9481,7 @@ ExecCommandCLKernelCache = record //TODO Надо ли "()->" перед arg_cache? Разница в том что: // - Без "()->" его будет читать прямо перед вызовом InvokeParams // - А сейчас его считает аж в EnqFunc - 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), @@ -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 := @@ -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), @@ -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; diff --git a/Packing/Descriptions/OpenCLABC.predoc b/Packing/Descriptions/OpenCLABC.predoc index 58626497..b2ea47da 100644 --- a/Packing/Descriptions/OpenCLABC.predoc +++ b/Packing/Descriptions/OpenCLABC.predoc @@ -7903,27 +7903,22 @@ type {$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; @@ -7934,6 +7929,16 @@ type 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; @@ -16634,14 +16639,24 @@ type 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)] @@ -16700,11 +16715,11 @@ type 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}); @@ -16750,14 +16765,14 @@ type 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; @@ -16962,7 +16977,7 @@ type //TODO Надо ли "()->" перед arg_cache? Разница в том что: // - Без "()->" его будет читать прямо перед вызовом InvokeParams // - А сейчас его считает аж в EnqFunc - 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), @@ -16971,7 +16986,7 @@ type ); 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 := @@ -17007,7 +17022,7 @@ type 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), @@ -17016,7 +17031,7 @@ type ); 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; diff --git "a/Tests/Exec/CLABC/02#\320\222\321\213\320\277\320\276\320\273\320\275\320\265\320\275\320\270\320\265 \320\276\321\207\320\265\321\200\320\265\320\264\320\265\320\271/11#Finally+Handle/BranchUnCancel.pas" "b/Tests/Exec/CLABC/02#\320\222\321\213\320\277\320\276\320\273\320\275\320\265\320\275\320\270\320\265 \320\276\321\207\320\265\321\200\320\265\320\264\320\265\320\271/11#Finally+Handle/BranchUnCancel.pas" index c69723dc..743988c5 100644 --- "a/Tests/Exec/CLABC/02#\320\222\321\213\320\277\320\276\320\273\320\275\320\265\320\275\320\270\320\265 \320\276\321\207\320\265\321\200\320\265\320\264\320\265\320\271/11#Finally+Handle/BranchUnCancel.pas" +++ "b/Tests/Exec/CLABC/02#\320\222\321\213\320\277\320\276\320\273\320\275\320\265\320\275\320\270\320\265 \320\276\321\207\320\265\321\200\320\265\320\264\320\265\320\271/11#Finally+Handle/BranchUnCancel.pas" @@ -13,6 +13,4 @@ lock output do e.Message.Println; Result := true; end) -); - -; \ No newline at end of file +); \ No newline at end of file