* * *

Author Topic: Calling a function outside with arguments in different type in TThread.Execute  (Read 2218 times)

sainimu78

  • Jr. Member
  • **
  • Posts: 80
I'm tired of writing lots of lines to do just calling a function when synchronizing.

Code: Pascal  [Select]
  1. trd.arg1 := str;
  2. trd.arg2 := num;
  3. trd.Synchronize(@Proc);
  4.  

I tried to simplify, then the calling becomes

Code: Pascal  [Select]
  1. type
  2.   TMyThread = class(TThread)
  3.   public
  4.     procedure Execute; override;
  5.   end;
  6.  
  7.   { TForm1 }
  8.  
  9.   TForm1 = class(TForm)
  10.     StartThread:TButton;
  11.     ComboBox1:TComboBox;
  12.     procedure AddStr(pArgStr:PString; pArgCnt:PInteger);
  13.                 function AddStr2(pArgStr:PString; pArgCnt:PInteger):Integer;
  14.     procedure DelStr(pArgIdx:PInteger);
  15.     procedure StartThreadClick(Sender:TObject);
  16.   private
  17.     { private declarations }
  18.   public
  19.     { public declarations }
  20.   end;
  21.  
  22. var
  23.   Form1: TForm1;
  24.   g_cnt:Integer=0;
  25.   g_str:string='demostr';
  26.  
  27. implementation
  28.  
  29. { TForm1 }
  30.  
  31. procedure TMyThread.Execute;
  32. var
  33.   idx:Integer;
  34. begin
  35.   g_cnt := MainSyncExecuteInt32Ret(TCallBack(@Form1.AddStr2), [@g_str, @g_cnt]);
  36.   idx := g_cnt - 1;
  37.   mainSync.Execute(TCallBack(@Form1.DelStr), [@idx]);
  38.   mainSync.Execute(TCallBack(@Form1.AddStr), [@g_str, @g_cnt]);
  39. end;
  40.  
  41. procedure TForm1.AddStr(pArgStr:PString; pArgCnt:PInteger);
  42. begin
  43.   ComboBox1.Items.Add(pArgStr^ + ', ' + IntToStr(pArgCnt^));
  44. end;
  45.  
  46. function TForm1.AddStr2(pArgStr:PString; pArgCnt:PInteger):Integer;
  47. begin
  48.   ComboBox1.Items.Add(pArgStr^ + ', ' + IntToStr(pArgCnt^));
  49.   result := ComboBox1.Items.Count;
  50. end;
  51.  
  52. procedure TForm1.DelStr(pArgIdx:PInteger);
  53. begin
  54.         ComboBox1.Items.Delete(pArgIdx^);
  55. end;
  56.  
  57. procedure TForm1.StartThreadClick(Sender:TObject);
  58. begin
  59.   with TMyThread.Create(True) do
  60.         begin
  61.     FreeOnTerminate := True;
  62.     Start;
  63.   end;
  64. end;

Supports all args of Pointer only.

The TMainSync and TFuncCallStack is here

Code: Pascal  [Select]
  1.  
  2. { TMainSync }
  3.  
  4. procedure TMainSync.Execute(argFunc:TCallback; arrArgs:array of const);
  5. begin
  6.   Execute(TFuncCallStack.Create(argFunc, arrArgs));
  7. end;
  8.  
  9. function TMainSync.Execute(argStk:TFuncCallStackBase):Pointer;
  10. begin
  11.   EnterCriticalsection(lock);
  12.   fArgStk := argStk;
  13.   TThread.Queue(nil, @Sync);
  14.   if(GetCurrentThreadId <> MainThreadId)then
  15.   begin
  16.     BasicEventWaitForEvent(pEvt, -1);
  17.   end
  18.   else
  19.   begin
  20.     argStk.Call;
  21.   end;
  22.   result := argStk.ret;
  23.   argStk.Free;
  24.   LeaveCriticalsection(lock);
  25. end;
  26.  
  27. procedure TMainSync.Sync;
  28. begin
  29.   fArgStk.Call;
  30.   BasicEventSetEvent(pEvt);
  31. end;
  32.  
  33. type
  34.  
  35.   TCallBack = procedure() of object;
  36.   TCallback0Args = procedure() of object;
  37.   TCallback1Args = procedure(arg1:Pointer) of object;
  38.   TCallback2Args = procedure(arg1:Pointer; arg2:Pointer) of object;
  39.   TCallback3Args = procedure(arg1:Pointer; arg2:Pointer; arg3:Pointer) of object;
  40.   TCallback4Args = procedure(arg1:Pointer; arg2:Pointer; arg3:Pointer; arg4:Pointer) of object;
  41.   TCallback5Args = procedure(arg1:Pointer; arg2:Pointer; arg3:Pointer; arg4:Pointer; arg5:Pointer) of object;
  42.   TCallback6Args = procedure(arg1:Pointer; arg2:Pointer; arg3:Pointer; arg4:Pointer; arg5:Pointer; arg6:Pointer) of object;
  43.   TCallback7Args = procedure(arg1:Pointer; arg2:Pointer; arg3:Pointer; arg4:Pointer; arg5:Pointer; arg6:Pointer; arg7:Pointer) of object;
  44.   TCallback8Args = procedure(arg1:Pointer; arg2:Pointer; arg3:Pointer; arg4:Pointer; arg5:Pointer; arg6:Pointer; arg7:Pointer; arg8:Pointer) of object;
  45.   TCallback9Args = procedure(arg1:Pointer; arg2:Pointer; arg3:Pointer; arg4:Pointer; arg5:Pointer; arg6:Pointer; arg7:Pointer; arg8:Pointer; arg9:Pointer) of object;
  46.   TCallback10Args = procedure(arg1:Pointer; arg2:Pointer; arg3:Pointer; arg4:Pointer; arg5:Pointer; arg6:Pointer; arg7:Pointer; arg8:Pointer; arg9:Pointer; arg10:Pointer) of object;
  47.          
  48. { TFuncCallStack }
  49.  
  50. procedure TFuncCallStack.Call;
  51. begin
  52.   if(Pointer(PtrInt(cbFunc)) = nil)then
  53.         Exit;
  54.   case numArgs of
  55.         0:      TCallback0Args(cbFunc)();
  56.         1:      TCallback1Args(cbFunc)(ppArgs[0]);
  57.         2:      TCallback2Args(cbFunc)(ppArgs[0], ppArgs[1]);
  58.         3:      TCallback3Args(cbFunc)(ppArgs[0], ppArgs[1], ppArgs[2]);
  59.         4:      TCallback4Args(cbFunc)(ppArgs[0], ppArgs[1], ppArgs[2], ppArgs[3]);
  60.         5:      TCallback5Args(cbFunc)(ppArgs[0], ppArgs[1], ppArgs[2], ppArgs[3], ppArgs[4]);
  61.         6:      TCallback6Args(cbFunc)(ppArgs[0], ppArgs[1], ppArgs[2], ppArgs[3], ppArgs[4], ppArgs[5]);
  62.         7:      TCallback7Args(cbFunc)(ppArgs[0], ppArgs[1], ppArgs[2], ppArgs[3], ppArgs[4], ppArgs[5], ppArgs[6]);
  63.         8:      TCallback8Args(cbFunc)(ppArgs[0], ppArgs[1], ppArgs[2], ppArgs[3], ppArgs[4], ppArgs[5], ppArgs[6], ppArgs[7]);
  64.         9:      TCallback9Args(cbFunc)(ppArgs[0], ppArgs[1], ppArgs[2], ppArgs[3], ppArgs[4], ppArgs[5], ppArgs[6], ppArgs[7], ppArgs[8]);
  65.         10:     TCallback10Args(cbFunc)(ppArgs[0], ppArgs[1], ppArgs[2], ppArgs[3], ppArgs[4], ppArgs[5], ppArgs[6], ppArgs[7], ppArgs[8], ppArgs[9]);
  66.   end;
  67. end;
  68.  
  69.  

My efforts has been made, but not yet simplied enough.

Code: Pascal  [Select]
  1. mainSync.Execute(TCallBack(@Form1.DelStr), [@idx]);

 If the type conversion "TCallback()" can be stripped out and the type of the args among the "[]" can be not just Pointer, then this way becomes realy beatifully simplied calling a function one.
« Last Edit: December 07, 2016, 02:46:36 pm by sainimu78 »

Remy Lebeau

  • Sr. Member
  • ****
  • Posts: 334
    • Lebeau Software
I'm tired of writing lots of lines to do just calling a function when synchronizing.

Code: Pascal  [Select]
  1. trd.arg1 := str;
  2. trd.arg2 := num;
  3. trd.Synchronize(@Proc);
  4.  

In Delphi, you can use an anonymous procedure with TThread.Synchronize() and TThread.Queue():

Code: Pascal  [Select]
  1. trd.Synchronize(
  2.   procedure
  3.   begin
  4.     Proc(str, num);
  5.   end
  6. );
  7.  

Or:

Code: Pascal  [Select]
  1. TThread.Synchronize(nil,
  2.   procedure
  3.   begin
  4.     Proc(str, num);
  5.   end
  6. );
  7.  

But, while FreePascal does have anonymous procedures, TThread does not support them yet in Synchronize() and Queue().  Might be worth a feature request.
Remy Lebeau
Lebeau Software - Owner, Developer
Internet Direct (Indy) open source project - Admin, Developer

sainimu78

  • Jr. Member
  • **
  • Posts: 80


Last time I saw your showing and I tried in lazarus, this cannot be compiled.

Remy Lebeau

  • Sr. Member
  • ****
  • Posts: 334
    • Lebeau Software
Last time I saw your showing and I tried in lazarus, this cannot be compiled.

Like I said, "TThread does not support [anonymous procedures] yet in Synchronize() and Queue()".
Remy Lebeau
Lebeau Software - Owner, Developer
Internet Direct (Indy) open source project - Admin, Developer

Cyrax

  • Hero Member
  • *****
  • Posts: 542
Actually FPC doesn't (yet) support anonymous procedures/methods.

Thaddy

  • Hero Member
  • *****
  • Posts: 4617
There is the similar "blocks" in trunk,but only for FPC for MAC OSX 10.7 and higher.
http://wiki.freepascal.org/FPC_New_Features_Trunk#Support_for_interfacing_with_C_blocks_functionality

To me that syntax looks a bit cumbersome compared to the Delphi syntax for anonymous methods.
I understand some work has been done in a separate branch,but that seems a bit dead atm.
« Last Edit: December 11, 2016, 11:21:35 am by Thaddy »
"Logically, no number of positive outcomes at the level of experimental testing can confirm a scientific theory, but a single counterexample is logically decisive."

PascalDragon

  • New member
  • *
  • Posts: 38
  • Compiler Developer
@Thaddy: you put up a link to "New Features Trunk" so why do you think the branch is dead? Yes, because it's been successfully merged to trunk! Also the cblocks feature is mainly for Objective C compatibility.

Delphi compatible anonymous functions are in the works however and as soon as they are available classes like TThread will be extended accordingly.

 

Recent

Get Lazarus at SourceForge.net. Fast, secure and Free Open Source software downloads Open Hub project report for Lazarus