Pascal - Playing with Records - Part Six

   
   
 cli  functional  
 code  
Article Series

This article series discuss more than 30 different programming languages. Please read overview before you read any of the details.

Playing with Records Related Articles.

Table of Content
Where to Discuss?

Local Group

Preface

Goal: Passing message between thread in Free Pascal.

This won’t be like go channel. However we can pass message between TThread class.

For real world situation, we might need to use synchronize method. But for this example, I keep this simple.

Real World Example

You can see my long real example, that I have made 14 years ago:

I was using TThread to export data from FirebirdSQL, into OpenOffice Calc, and also Microsoft Excel. But this voluntary project stopped, and disposed years ago. This only take just a few months of usage.

14: Messages Between Threads.

The Actors

We need two classes:

  • TSender in MySender
  • TReceiver in MyReceiver

And we are going to use both in main program, as this two variables:

var
  Producer : TSender;
  Consumer : TReceiver;

MySender Unit: Interface

Look how this MySender class depends on MyReceiver class.

{$mode objFPC}
unit MySender;

interface
Uses CThreads, Classes, SysUtils, MyReceiver;

type
  TSender = class(TThread)
  private
    Messages: TStringArray;
    Consumer: TReceiver;
  protected
    procedure Execute; override;
  public
    Constructor Create(
      CreateSuspended : boolean;
      msgs: TStringArray;
      Receiver: TReceiver);
  end;

Pascal: MySender: Interface

Note that windows user do not require CThreads.

MySender Unit: Implementation

It is just the constructor.

Constructor TSender.Create(
  CreateSuspended : boolean;
  msgs: TStringArray;
  Receiver: TReceiver);
begin
  Messages := msgs;
  Consumer := Receiver;

  inherited Create(CreateSuspended);
  FreeOnTerminate := True;
end;

Pascal: MySender: Implementation

And the execute method.

procedure TSender.Execute;
var  Tag : string;
begin
  for Tag in Messages do begin
    WriteLn('In Sender Thread   : ' + Tag);
    Consumer.Msg := Tag;
  end;
  Consumer.SetStop();

  WriteLn('Quit Sender');
end;

Pascal: MySender: Implementation

MyReceiver Unit: Interface

Prepare the unit.

{$mode objFPC}
unit MyReceiver;

interface
Uses CThreads, Classes, SysUtils;

Note that windows user do not require CThreads.

TReceiver Class Type

Then overview of the object. We can see the summary easily with Pascal.

type
  TReceiver = class(TThread)
  private
    Messages  : TStringList;
    isStop    : boolean;
  protected
    procedure Execute; override;
    procedure SetMessage(msg: string);
    function GetMessage: string;
  public
    constructor Create(
      CreateSuspended : boolean);
    procedure SetStop();
    property Msg: string
      read GetMessage write SetMessage;
  end;

Pascal: MyReceiver: Interface

We have a few methods to be implemented.

  • Constructor.
  • Property: Get and Set.
  • Execute: and how to stop the loop.

The explanation would be long.

MyReceiver Unit: Implementation: Constructor

constructor TReceiver.Create(
  CreateSuspended : boolean);
begin
  Messages := TStringList.Create;
  isStop := false;

  inherited Create(CreateSuspended);
  FreeOnTerminate := True;
end;

Pascal: MyReceiver: Implementation

We should initialize the string list.

MyReceiver Unit: Implementation: Property

Getter and Setter.

Or in other world, push and pull the string list, using FIFO.

procedure TReceiver.SetMessage(msg: string);
begin
  Messages.Add(Msg);
end;

function TReceiver.GetMessage: string;
begin
  Result := Messages[0];
  Messages.Delete(0);
end;

Pascal: MyReceiver: Implementation

MyReceiver Unit: Implementation: Execute

And the execute method containing infinite loop, until the other thread sent stop signal.

procedure TReceiver.SetStop();
begin
  isStop := true;
end;

procedure TReceiver.Execute;
begin
  repeat
    if Messages.Count > 0 then
      WriteLn('In Receiver Thread : ' + Msg);
  until (isStop and (Messages.Count = 0));
  WriteLn('Quit Receiver');
end;

Pascal: MyReceiver: Implementation

The stop signal does not suddenly stop the receiver thread. It has to empty the string list first.

You can free the TStringList as well, if you want perfection.

destructor TReceiver.Destroy;
begin
  Messages.Free;
  inherited Destroy;
end;

I simply forget to clean up.

Using MySender and My Receiver

Consider gather together in main program.

Declare everything as usual. This should be self explanatory.

{$mode objFPC}
Uses
  CThreads, Classes, SysUtils,
  MySender, MyReceiver;

var
  Producer : TSender;
  Consumer : TReceiver;

  Tags : TStringArray =
    ('60s', 'jazz', '60s', 'rock',
     '70s', 'rock', '70s', 'pop');

Pascal: Messages: Using The Unit: Header

Now you can see how simple of using TThread, Both thread can run concurrently as separate processes.

However, since this is not like go channel. We still need to tell the producer constructor, that we sent to the message to receiver.

begin
  Consumer := TReceiver.Create(True);
  Producer := TSender.Create(True, Tags, Consumer);

  Producer.Start;
  Consumer.Start;

  Consumer.WaitFor;
  Producer.WaitFor;
end.

Pascal: Messages: Using The Unit: Main

We are using Waitfor so that, the application won’t quit immediately.

Result

Enjoy the multi processing.

❯ ./33-messages
In Sender Thread   : 60s
In Sender Thread   : jazz
In Receiver Thread : 60s
In Sender Thread   : 60s
In Receiver Thread : jazz
In Sender Thread   : rock
In Receiver Thread : 60s
In Sender Thread   : 70s
In Receiver Thread : rock
In Sender Thread   : rock
In Receiver Thread : 70s
In Sender Thread   : 70s
In Receiver Thread : rock
In Sender Thread   : pop
In Receiver Thread : 70s
Quit Sender
In Receiver Thread : pop
Quit Receiver

Pascal: Messages: Using The Unit: Result

You can add delay, to see how both processes, run separately with each other.

15: The Songs Threads

We are having a good time with TThread right? How about get a unique songs tag in multithreading fashioned? It is also going to be fun.

The Actors

Just add song suffix.

We need two classes:

  • TSenderSong in MySenderSong
  • TReceiverSong in MyReceiverSong

And we are going to use both in main program, as this two variables:

var
  Producer : TSenderSong;
  Consumer : TReceiverSong;

MySenderSong Unit: Interface

Exactly the same, except the suffix.

And also look how this MySenderSong class, depends on MyReceiverSong class.

{$mode objFPC}
unit MySenderSong;

interface
Uses
  CThreads, Classes, SysUtils,
  MySongs, MyReceiverSong;

type
  TSenderSong = class(TThread)
  private
    Messages: TStringArray;
    Consumer: TReceiverSong;
  protected
    procedure Execute; override;
  public
    Constructor Create(
      CreateSuspended : boolean;
      Receiver: TReceiverSong);
  end;

Pascal: MySenderSong: Interface

MySenderSong Unit: Implementation

It is just the constructor, that fill the song tags immediately.

Constructor TSenderSong.Create(
  CreateSuspended : boolean;
  Receiver: TReceiverSong);
var Song: TSong;
begin
  Messages := [];
  for Song in Songs do
    Insert(Song.Tags, Messages, High(Messages)+1);

  Consumer := Receiver;

  inherited Create(CreateSuspended);
  FreeOnTerminate := True;
end;

Pascal: MySenderSong: Implementation

And the execute method, is just removing unnecessary message from previous class.

procedure TSenderSong.Execute;
var Tag : string;
begin
  for Tag in Messages do
    Consumer.Msg := Tag;
  Consumer.SetStop();
end;

Pascal: MySenderSong: Implementation

MyReceiverSong Unit: Interface

Prepare the unit.

{$mode objFPC}
unit MyReceiverSong;

interface
Uses CThreads, Classes, SysUtils;

Pascal: MyReceiverSong: Interface: Uses

TReceiverSong Class Type

Exactly the same as previous unit, except the suffix.

Then overview of the object. We can see the summary easily with Pascal.

type
  TReceiverSong = class(TThread)
  private
    Messages  : TStringList;
    isStop    : boolean;
  protected
    procedure Execute; override;
    procedure SetMessage(msg: string);
    function GetMessage: string;
  public
    constructor Create(
      CreateSuspended : boolean);
    procedure SetStop();
    property Msg: string
      read GetMessage write SetMessage;
  end;

Pascal: MyReceiverSong: Interface: Type

We have the same methods to be implemented.

  • Constructor.
  • Property: Get and Set.
  • Execute: and how to stop the loop.

MyReceiverSong Unit: Implementation: Constructor

And also SetStop Method

Exactly the same as previous unit, except the suffix.

constructor TReceiverSong.Create(
  CreateSuspended : boolean);
begin
  Messages := TStringList.Create;
  isStop := false;

  inherited Create(CreateSuspended);
  FreeOnTerminate := True;
end;

destructor TReceiverSong.Destroy;
begin
  Messages.Free;
  inherited Destroy;
end;
procedure TReceiverSong.SetStop();
begin
  isStop := true;
end;

Pascal: MyReceiverSong: Implementation

MyReceiverSong Unit: Implementation: Property

Getter and Setter

Or in other world, push and pull the string list, using FIFO.

procedure TReceiverSong.SetMessage(msg: string);
begin
  Messages.Add(Msg);
end;

function TReceiverSong.GetMessage: string;
begin
  Result := Messages[0];
  Messages.Delete(0);
end;

Pascal: MyReceiverSong: Implementation

MyReceiverSong Unit: Implementation: Execute

And the execute method containing infinite loop, until the other thread sent stop signal.

This is a little bit longer, because we calculate the result directly.

procedure TReceiverSong.Execute;
var
  SL : TStringList;
  SR : String;
begin
  SL := TStringList.Create;
  SL.Duplicates := dupIgnore;
  SL.Sorted := true;

  repeat
    if Messages.Count > 0 then
      SL.Add(Msg);
  until (isStop and (Messages.Count = 0));

  SL.Delimiter := '|';
  SR := StringReplace(
    SL.DelimitedText, '|', ', ',
    [rfReplaceAll, rfIgnoreCase]);
  WriteLn(SR);

  SL.Free;
end;

Pascal: MyReceiverSong: Implementation

Using MySenderSong and My ReceiverSong

Consider gather together in main program.

Declare everything as usual. This should be self explanatory.

{$mode objFPC}
Uses
  CThreads, Classes, SysUtils,
  MySenderSong, MyReceiverSong;

var
  Producer : TSenderSong;
  Consumer : TReceiverSong;

Pascal: Songs Thread: Using The Unit: Header

And run both processes.

begin
  Consumer := TReceiverSong.Create(True);
  Producer := TSenderSong.Create(True, Consumer);

  Producer.Start;
  Consumer.Start;

  Consumer.WaitFor;
  Producer.WaitFor;
end.

Pascal: Songs Thread: Using The Unit: Main

Result

Enjoy the multi processing.

❯ ./34-songs
60s, 70s, jazz, pop, rock

Not very fancy. But it is done.

I hope you satisfied with the example.

Conclusion

Thank you for reading.