Recent

Author Topic: [SOLVED] BeginThread usage  (Read 12243 times)

aradeonas

  • Hero Member
  • *****
  • Posts: 824
[SOLVED] BeginThread usage
« on: August 16, 2015, 08:09:42 am »
Hi,

I want to use BeginThread but because I couldn't find any FPC example I tried to use this as an example but multi problem will happen.I want to know how can I use BeginThread properly.
http://www.delphibasics.co.uk/RTL.asp?Name=BeginThread
http://wiki.freepascal.org/Multithreaded_Application_Tutorial#External_threads
http://orion.lcg.ufrj.br/RPMS/myrpms/lazarus/fpc-lazarus-doc/rtl/system/beginthread.html
for example when I change the code to this so runs in the Lazarus I will get synchronize error :
Code: [Select]
unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs;

type
  TMsgRecord = record
    thread: integer;
    msg: string[30];
  end;

  { TForm1 }

  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}
threadvar         // We must allow each thread its own instances
  // of the passed record variable
  msgPtr: ^TMsgRecord;
// Private thread procedure to show a string
function ShowMsg(Parameter: Pointer): integer;
begin
  // Set up a 0 return value
  Result := 0;

  // Map the pointer to the passed data
  // Note that each thread has a separate copy of msgPtr
  msgPtr := Parameter;

  // Display this message
  ShowMessagePos('Thread ' + IntToStr(msgPtr^.thread) + ' ' + msgPtr^.msg,
    200 * msgPtr^.thread, 100);

  // End the thread
  EndThread(0);
end;

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
var
  id1, id2: longword;
  thread1, thread2: integer;
  msg1, msg2: TMsgRecord;

begin
  // set up our display messages
  msg1.thread := 1;
  msg1.msg := 'Hello World';
  msg2.thread := 2;
  msg2.msg := 'Goodbye World';

  // Start the first thread running asking for users first name
  thread1 := BeginThread(nil, 0,@ShowMsg,msg1),0, id1);

  // And also ask for the surname
  thread2 := BeginThread(nil, 0,@ShowMsg, msg2),0, id2);

  // Ensure that the threads are only closed when all done
  ShowMessagePos('Press this when other dialogs finished.', 200, 300);

  // Finally, tidy up by closing the threads
  //CloseHandle(thread1);
  //CloseHandle(thread2);
end;

end.

Also CloseHandle is not available ,so how can I close them?
« Last Edit: August 16, 2015, 05:35:37 pm by aradeonas »

ChrisF

  • Hero Member
  • *****
  • Posts: 542
Re: BeginThread usage
« Reply #1 on: August 16, 2015, 03:55:32 pm »
I'm not sure this sample code (i.e. http://www.delphibasics.co.uk/RTL.asp?Name=BeginThread) is really a good sample.

It's not even running correctly with Delphi 7 (which seems normal to me, BTW).

First of all:
 - you can compile exactly the sample code if you use the "{$mode delphi}" directive instead of the "{$mode objfpc}{$H+}" one. Except for the "{$R *.dfm}" directive, of course
 - CloseHandle is a Windows API. And Delphi adds automatically the "Windows" unit in its "use" clause; so, add it also in your own "use" clause.

Concerning your error when you run the program, it's quite normal. The LCL (like the VCL) is not thread safe.

So, when a thread wants to deal with LCL objects, it must use the Synchronize method. And this method is available only with the Thread class (i.e. not with BeginThread AFAIK).

Just for a demonstration purpose, you can make a test with this sample by using a Windows API call in the thread function, instead of using the LCL one.

Replace:
Code: [Select]
ShowMessagePos('Thread '+IntToStr(msgPtr.thread)+'  '+msgPtr.msg,
          200*msgPtr.thread, 100);

with:
Code: [Select]
MessageBoxA(0,PChar('Thread '+IntToStr(msgPtr.thread)+' '+msgPtr.msg),'Thread title',0);

But once again, it's just a dirty hack for this sample.

ChrisF

  • Hero Member
  • *****
  • Posts: 542
Re: BeginThread usage
« Reply #2 on: August 16, 2015, 04:00:39 pm »
BTW, there is a copy-and-paste error in your code with these instructions:
Code: [Select]
thread1 := BeginThread(nil, 0,@ShowMsg,msg1),0, id1);

thread2 := BeginThread(nil, 0,@ShowMsg, msg2),0, id2);

Use "Addr(msgi)", or "@msgi".

aradeonas

  • Hero Member
  • *****
  • Posts: 824
Re: BeginThread usage
« Reply #3 on: August 16, 2015, 04:02:11 pm »
Thanks.
So what is the standard and clean way of using BeginThread ?

ChrisF

  • Hero Member
  • *****
  • Posts: 542
Re: BeginThread usage
« Reply #4 on: August 16, 2015, 04:51:48 pm »
The problem in the sample is mainly what is done inside the thread function; not exactly the BeginThread call itself.

If you want to interact with the LCL, you'd better use the TThread class instead. If you just want to use a very simple thread function, without any interaction with the LCL, BeginThread is OK.

So, it depends of your need.


Hereafter a very basic Lazarus test program, using a global variable and a timer to test the end of the thread (see atached project "BeginThreadTest.zip").

The interesting part of the code:
Code: [Select]
...

uses
  Windows;

function MyThreadFunc(Parameter: pointer): integer; forward;

var
  ThreadId: TThreadID;
  ThreadOver: Boolean;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Application.Terminate;
end;

procedure TForm1.Button2Click(Sender: TObject);
var i: Longword;
begin
  StaticText1.Caption := '';
  ThreadOver := false;
  ThreadId := BeginThread(nil, 0, @MyThreadFunc, @ThreadOver, 0, i);
  if ThreadId = 0 then
    ShowMessage('Error when beginning thread')
  else
    begin
      StaticText1.Caption := sLineBreak + 'Thread is running...';
      Timer1.Enabled := true;
    end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  if ThreadOver then
    begin
      CloseHandle(ThreadId);
      StaticText1.Caption := sLineBreak + 'Thread has stopped.';
      Timer1.Enabled := False;
    end;
end;

function MyThreadFunc(Parameter: pointer): integer;
const NumberOfSeconds = 10;
var i: integer;
begin
  result := 0;    // (Avoids warning);
  i := 0;
  while i < NumberOfSeconds do
    begin
      SysUtils.Beep;
      SysUtils.Sleep(1000);
      inc(i);
    end;
  ThreadOver := true;
  EndThread(0);
end;


Another Free Pascal test program to simulate a timer for a console program, using mainly Windows API (see "ttest.zip"), especially to detect the end of the thread.

Code: [Select]
program ttest;

{$mode objfpc}{$H+}

uses Windows;

const TIMER_INTERVAL  = 5000;     // (ms)
const TIMER_NBREVENTS = 1;        // Number of External Events to look for in the Timer Thread (Only 1 in this sample)

const TIMER_MAXTICKS  = 4;        // Maximum Number of Timer Ticks (To simulate a way to exit from the test program)

var
  HandEvGloEnd: Longword = 0;     // Handle for Event : Global End
  HandEvReqEnd: Longword = 0;     // Handle for Event : Request End
  HandleThread: Longword = 0;     // Handle for Timer Thread

  NbrTimerTicks: Integer = 0;     // Current Number of Timer Ticks

// Called on Each Timer Tick
procedure ProcToCall();
begin
  Writeln('Timer Tick');
  Inc(NbrTimerTicks);
  if NbrTimerTicks>=TIMER_MAXTICKS then
    SetEvent(HandEvGloEnd);   // Ask to quit the main infinite waiting
end;

function  TimerThread(PP: Pointer): Integer;
var ArrEvHandle: array [0..Pred(TIMER_NBREVENTS)] of Longword;  // Array of Events to Look for
begin
  ArrEvHandle[0]:=HandEvReqEnd;
  while True do
    begin
      Write('Waiting ...  ');
      WaitForMultipleObjects(TIMER_NBREVENTS,@ArrEvHandle,False,TIMER_INTERVAL);
      if WaitforSingleObject(HandEvReqEnd,0)<>WAIT_TIMEOUT then // Request to End ?
        begin
          Writeln('No more waiting');
          Break;
        end;
      ProcToCall();
    end;
  Result:=0;
  EndThread(0);
end;

procedure StartTimerThread();
var i1: Longword;
begin
  Writeln();
  Writeln('Start Timer Thread');
  HandEvReqEnd:=CreateEvent(Nil,True,False,PChar('MyEventNames_ReqEnd'));
  HandleThread:=BeginThread(Nil,0,TThreadFunc(@TimerThread),Nil,0,i1);
end;

procedure StopTimerThread(Const ExitForced: Integer);
begin
  Writeln('Stop Timer Thread');
  if ExitForced=0 then
    begin
      SetEvent(HandEvReqEnd);
      WaitForSingleObject(HandleThread,3000);       // Wait 3s mawimum for the "real" ending of the thread (it should be quite enough)
    end;
  CloseHandle(HandEvReqEnd);
  CloseHandle(HandleThread);
end;

begin
  HandEvGloEnd:=CreateEvent(Nil,True,False,PChar('MyEventNames_GloEnd'));
  StartTimerThread();
  WaitforSingleObject(HandEvGloEnd,INFINITE);   // Simulate an infinite waiting
  StopTimerThread(0);
  CloseHandle(HandEvGloEnd);
end.


*** Edit *** And BeginThread is not very portable, while TThread is.
« Last Edit: August 16, 2015, 05:11:56 pm by ChrisF »

aradeonas

  • Hero Member
  • *****
  • Posts: 824
Re: BeginThread usage
« Reply #5 on: August 16, 2015, 05:12:39 pm »
I appreciate your help, thank you for the complete examples

ChrisF

  • Hero Member
  • *****
  • Posts: 542
Re: BeginThread usage
« Reply #6 on: August 16, 2015, 05:38:13 pm »
You're welcome.

My first sample has been coded very quickly and I'm seeing there are a few minor problems.

In the function "MyThreadFunc", the parameter should be used instead of the global variable:
Code: [Select]
  Boolean(Parameter^) := true;
instead of
  ThreadOver := true;

Only one instance of the thread is supposed to run here, so it'd be safer to "protect" the thread start, for instance by disabling the corresponding button.

In "TForm1.Button2Click":
Code: [Select]
    begin
      StaticText1.Caption := sLineBreak + 'Thread is running...';
      Timer1.Enabled := true;
      Button2.Enabled := false;     // <- Add me
    end;
And in TForm1.Timer1Timer:
Code: [Select]
    begin
      CloseHandle(ThreadId);
      StaticText1.Caption := sLineBreak + 'Thread has stopped.';
      Timer1.Enabled := False;
      Button2.Enabled := true;     // <- Add me
    end;

aradeonas

  • Hero Member
  • *****
  • Posts: 824
Re: [SOLVED] BeginThread usage
« Reply #7 on: August 16, 2015, 08:28:24 pm »
Yes I notice that.It will others too.
Thanks.

Roland57

  • Sr. Member
  • ****
  • Posts: 421
    • msegui.net
Re: BeginThread usage
« Reply #8 on: January 29, 2020, 09:13:44 am »
Hereafter a very basic Lazarus test program, using a global variable and a timer to test the end of the thread (see attached project "BeginThreadTest.zip").

Hello! I try to compile this project without success. My Lazarus version is 2.0.6, FPC 3.0.4, x86_64-win64-win32/win64.

The error message, after I made this modification:

Code: Pascal  [Select][+][-]
  1. var i: {Longword}QWord;

is

Quote
unit1.pas(57,48) Error: Incompatible type for arg no. 3: Got "<address of function(Pointer):LongInt;Register>", expected "<procedure variable type of function(Pointer):Int64;Register>"

Could someone help me to solve the issue?

I am trying to port to Lazarus a Delphi project where the same issue appears.
My projects are on Gitlab and on Codeberg.

Thaddy

  • Hero Member
  • *****
  • Posts: 14201
  • Probably until I exterminate Putin.
Re: [SOLVED] BeginThread usage
« Reply #9 on: January 29, 2020, 09:15:59 am »
longword is wrong, use ptrUint. This can hold the correct pointer size on all platforms. (Documentation is too bitness specific here and says ptrUint = longword, but on 64 bit it is twice the size.)
« Last Edit: January 29, 2020, 09:18:21 am by Thaddy »
Specialize a type, not a var.

Roland57

  • Sr. Member
  • ****
  • Posts: 421
    • msegui.net
Re: [SOLVED] BeginThread usage
« Reply #10 on: January 29, 2020, 09:20:35 am »
longword is wrong, use ptrUint. This can hold the correct pointer size on all platforms. (Documentation is too bitness specific here and says ptrUint = longword, but on 64 bit it is twice the size.)

OK, thank you, I will remember that.

For the other error, I tried this, which seems to solve the problem.

Code: Pascal  [Select][+][-]
  1. function MyThreadFunc(Parameter: pointer): {integer}Int64; forward;

The program compiles and works.
My projects are on Gitlab and on Codeberg.

PascalDragon

  • Hero Member
  • *****
  • Posts: 5446
  • Compiler Developer
Re: [SOLVED] BeginThread usage
« Reply #11 on: January 29, 2020, 09:38:16 am »
For the other error, I tried this, which seems to solve the problem.

Code: Pascal  [Select][+][-]
  1. function MyThreadFunc(Parameter: pointer): {integer}Int64; forward;

The program compiles and works.

You should use PtrInt instead of Integer or Int64 here as well. This is how TThreadFunc (which your MyThreadFunc needs to match) is declared. Otherwise you'll have problems if you should compile for 32-bit again.

Roland57

  • Sr. Member
  • ****
  • Posts: 421
    • msegui.net
Re: [SOLVED] BeginThread usage
« Reply #12 on: January 29, 2020, 09:42:10 am »
You should use PtrInt instead of Integer or Int64 here as well. This is how TThreadFunc (which your MyThreadFunc needs to match) is declared. Otherwise you'll have problems if you should compile for 32-bit again.

I see. Thank you.
My projects are on Gitlab and on Codeberg.

Thaddy

  • Hero Member
  • *****
  • Posts: 14201
  • Probably until I exterminate Putin.
Re: [SOLVED] BeginThread usage
« Reply #13 on: January 29, 2020, 10:22:42 am »
You should use PtrInt instead of Integer or Int64 here as well. This is how TThreadFunc (which your MyThreadFunc needs to match) is declared. Otherwise you'll have problems if you should compile for 32-bit again.
Are you sure? Pointers can't be negative so ptrUint should be better.
Specialize a type, not a var.

PascalDragon

  • Hero Member
  • *****
  • Posts: 5446
  • Compiler Developer
Re: [SOLVED] BeginThread usage
« Reply #14 on: January 30, 2020, 09:17:33 am »
You should use PtrInt instead of Integer or Int64 here as well. This is how TThreadFunc (which your MyThreadFunc needs to match) is declared. Otherwise you'll have problems if you should compile for 32-bit again.
Are you sure? Pointers can't be negative so ptrUint should be better.

The function is declared as returning PtrInt so anything else will lead to a compile error:

Code: [Select]
ttest.pp(15,24) Error: Incompatible type for arg no. 1: Got "<address of function(Pointer):DWord;Register>", expected "<procedure variable type of function(Pointer):LongInt;Register>"

 

TinyPortal © 2005-2018