Sign in Join
Wiki copytemporary

MultithreadingAndCriticalsections

English · Français

Code Snippet demonstrating Thread programming

pascal
{$mode objfpc}{$H+}
program Project1;

uses
 {$ifdef unix}cthreads,
 {$endif}Classes,
  SysUtils;

var
  CriticalSection: TRTLCriticalSection;
  Counter: integer;
  UseCriticalSection: boolean;

  function Supposedly: string;
  begin
    if UseCriticalSection then
      Result:=''
    else Result:='supposedly ';
  end;

type
  { TMyThread }

  TMyThread = class(TThread)
  private
    FAFinished: boolean;
    FID: integer;
  public
    constructor Create(CreateSuspended: Boolean; ID: integer; const StackSize: SizeUInt=DefaultStackSize);
    procedure Execute; override;
    property AFinished: boolean read FAFinished write FAFinished;
  end;

  constructor TMyThread.Create(CreateSuspended: Boolean; ID: integer; const StackSize: SizeUInt);
  begin
    inherited Create(CreateSuspended, StackSize);
    FID:=ID;
  end;

  procedure TMyThread.Execute;
  var
    j: integer;
  begin
    FAFinished := False;
    if UseCriticalSection then
      EnterCriticalSection(CriticalSection);
    try
      for j := 1 to 1000000 do
        Inc(Counter);
      WriteLn(Format('Thread %d has %sfinished making 1000000 increments to Counter',[FID, Supposedly]));
    finally
      if UseCriticalSection then
        LeaveCriticalSection(CriticalSection);
    end;
    FAFinished := True;
  end;

  function HasCriticalSection: string;
  begin
    if UseCriticalSection then
      Result:=''
    else Result:='NOT ';
  end;

  procedure ExerciseThreads(aUseCriticalSection: boolean);
  var
    Threads: array[1..20] of TMyThread;
    AllFinished: boolean;
    i: integer;
  begin
    Counter := 0;
    UseCriticalSection:=aUseCriticalSection;
    WriteLn(Format('A critical section is %sbeing used; Counter starts at %d',[HasCriticalSection, Counter]));
    // start 20 threads
    for i := Low(Threads) to High(Threads) do
      Threads[i] := TMyThread.Create(False, i);
    // wait till all threads finished
    repeat
      AllFinished := True;
      for i := Low(Threads) to High(Threads) do
        if not Threads[i].AFinished then
          AllFinished := False;
    until AllFinished;
    // free the threads
    for i := Low(Threads) to High(Threads) do
      Threads[i].Free;
    WriteLn('Final value of Counter=' + IntToStr(Counter));
    WriteLn;
  end;

var
  b: boolean;
begin
    // create the CriticalSection
  InitCriticalSection(CriticalSection);

  for b in Boolean do
    ExerciseThreads(b);

    // free the CriticalSection
  DoneCriticalSection(CriticalSection);

  {$IfDef WINDOWS}
    Write(' Press [Enter] to finish');
    ReadLn;
  {$EndIf}
end.

From the Free Pascal wiki, page "MultithreadingAndCriticalsections", as it stood on 2021-05-06 after a change by Arent, out of the wiki's dump of 2024-05-26. Copyright stays with the author who wrote it, according to the old wiki's Licensing page. If you have concerns about this material, message the admin.

Revision 1, last changed by WikiArchive .

Talk about this page

Nobody has opened a bench for this page yet. Sign in to open one.