Recent

Author Topic: Semaphore example?  (Read 5237 times)

Trenatos

  • Hero Member
  • *****
  • Posts: 537
    • MarcusFernstrom.com
Semaphore example?
« on: January 06, 2020, 04:25:44 pm »
Can someone point me to an example of how to use semaphores in FPC? (https://www.freepascal.org/docs-html/rtl/system/semaphoreinit.html)

I've looked around but most all of what I'm seeing is for Delphi (http://edn.embarcadero.com/print/30027)
« Last Edit: January 06, 2020, 05:31:14 pm by Trenatos »

guest65109

  • Guest
Re: Semaphore example?
« Reply #1 on: January 06, 2020, 04:35:45 pm »
Can someone point me to an example of how to use semaphores in FPC? (https://www.freepascal.org/docs-html/rtl/system/semaphoreinit.html)

I've looked around but most all of what I'm seeing is for Delphi (http://edn.embarcadero.com/print/30027)

Don't take me serious but should be it's done the same as Delphi? Could you adapt the document for Delphi to Lazarus/FPC? I don't want to hurt anyone but the fact is Lazarus/FPC is just a shadow of Delphi, after all.

Trenatos

  • Hero Member
  • *****
  • Posts: 537
    • MarcusFernstrom.com
Re: Semaphore example?
« Reply #2 on: January 06, 2020, 04:48:29 pm »
Eh?

Delphi is an implementation of Object Pascal + GUI tools, so is FreePascal + Lazarus.

FPC has a Delphi mode, but it's not an open source copy of Delphi, they're two separate implementations.

winni

  • Hero Member
  • *****
  • Posts: 3197
Re: Semaphore example?
« Reply #3 on: January 06, 2020, 04:59:29 pm »
@Trenatos:

from: https://wiki.freepascal.org/Threads

Semaphores

Semaphores were Posix-only, and have been deprecated. They block threads waiting for them, and each SemaphorePost releases one waiting thread.


@mr.coll:

Stop insulting the forum and its members. This is not the right place for you .

Winni
« Last Edit: January 06, 2020, 05:01:08 pm by winni »

Trenatos

  • Hero Member
  • *****
  • Posts: 537
    • MarcusFernstrom.com
Re: Semaphore example?
« Reply #4 on: January 06, 2020, 05:05:48 pm »
Aha, thanks Winni.

guest65109

  • Guest
Re: Semaphore example?
« Reply #5 on: January 06, 2020, 05:09:59 pm »
@mr.coll:

Stop insulting the forum and its members. This is not the right place for you .

Winni

OK. Sorry everyone. I will come back when I serious. But don't ban me, please. I promise I will not post anything anymore until then  :'(

PascalDragon

  • Hero Member
  • *****
  • Posts: 5851
  • Compiler Developer
Re: Semaphore example?
« Reply #6 on: January 07, 2020, 09:28:38 am »
Can someone point me to an example of how to use semaphores in FPC? (https://www.freepascal.org/docs-html/rtl/system/semaphoreinit.html)
The semaphore functionality is removed in 3.2, because it was only implemented for Unix anyway. We don't have a cross platform replacement currently, but the correct approach would be to port Delphi's SyncObjs.TSemaphore.

Thaddy

  • Hero Member
  • *****
  • Posts: 16520
  • Kallstadt seems a good place to evict Trump to.
Re: Semaphore example?
« Reply #7 on: January 07, 2020, 12:28:51 pm »
I once translated this: https://docs.microsoft.com/en-us/windows/win32/sync/using-semaphore-objects but lost it.
I can translate it again if you are not proficient in C. This one is windows only. It is not much work.
But I am sure they don't want the Trumps back...

Pascal

  • Hero Member
  • *****
  • Posts: 932
Re: Semaphore example?
« Reply #8 on: January 07, 2020, 02:07:28 pm »
You can try this. It's cross platform. Works for me on Windows and Linux.

Code: Pascal  [Select][+][-]
  1. unit Semaphore;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Contnrs,
  9.   Classes,
  10.   SysUtils;
  11.  
  12. type
  13.  
  14.   { TSemaphore }
  15.  
  16.   TSemaphore = class
  17.   private
  18.     fMaxPermits: Cardinal;
  19.     fPermits: Cardinal;
  20.     fLock: TRTLCriticalSection;
  21.     FBlockQueue: Contnrs.TQueue;
  22.     function GetWaitCount: Cardinal;
  23.   public
  24.     procedure Wait;
  25.     procedure Post;
  26.     function Used: Boolean;
  27.     constructor Create(MaxPermits: Cardinal);
  28.     destructor Destroy; override;
  29.     property WaitCount: Cardinal read GetWaitCount;
  30.     property Permits: Cardinal read fPermits;
  31.     property MaxPermits: Cardinal read fMaxPermits;
  32.   end;
  33.  
  34.  
  35. implementation
  36.  
  37. { TSemaphore }
  38.  
  39. function TSemaphore.GetWaitCount: Cardinal;
  40. begin
  41.   EnterCriticalSection(fLock);
  42.   try
  43.     Result:= FBlockQueue.Count;
  44.   finally
  45.     LeaveCriticalSection(fLock);
  46.   end;
  47. end;
  48.  
  49. procedure TSemaphore.Wait;
  50. var
  51.   aWait: Boolean;
  52.   aEvent: PRTLEvent;
  53. begin
  54.   //writeln('Sem:');
  55.   //writeln('  locking...');
  56.   EnterCriticalSection(fLock);
  57.   try
  58.     //writeln('  locked');
  59.     if (fPermits > 0) then begin
  60.       Dec(fPermits);
  61.       aWait:= False;
  62.     end else begin
  63.       aEvent:= RTLEventCreate;
  64.       FBlockQueue.Push(aEvent);
  65.       aWait:= True;
  66.     end;
  67.   finally
  68.     LeaveCriticalSection(fLock);
  69.   end;
  70.   if aWait then begin
  71.     //writeln('  waiting...');
  72.     RTLeventWaitFor(aEvent);
  73.     RTLEventDestroy(aEvent);
  74.   end;
  75.   //writeln('  aquired');
  76. end;
  77.  
  78. procedure TSemaphore.Post;
  79. begin
  80.   EnterCriticalSection(fLock);
  81.   try
  82.     if FBlockQueue.Count > 0 then
  83.       RTLEventSetEvent(PRTLEvent(FBlockQueue.Pop))
  84.     else
  85.       Inc(fPermits);
  86.   finally
  87.     LeaveCriticalSection(fLock);
  88.   end;
  89. end;
  90.  
  91. function TSemaphore.Used: Boolean;
  92. begin
  93.   EnterCriticalSection(fLock);
  94.   try
  95.     Result := fPermits < fMaxPermits;
  96.   finally
  97.     LeaveCriticalSection(fLock);
  98.   end;
  99. end;
  100.  
  101. constructor TSemaphore.Create(MaxPermits: Cardinal);
  102. begin
  103.   fMaxPermits := MaxPermits;
  104.   fPermits := MaxPermits;
  105.   InitCriticalSection(fLock);
  106.   FBlockQueue:= TQueue.Create;
  107. end;
  108.  
  109. destructor TSemaphore.Destroy;
  110. begin
  111.   DoneCriticalSection(fLock);
  112.   FBlockQueue.Free;
  113.   inherited Destroy;
  114. end;
  115.  
  116. end.
  117.  
laz trunk x64 - fpc trunk i386 (cross x64) - Windows 10 Pro x64 (21H2)

Trenatos

  • Hero Member
  • *****
  • Posts: 537
    • MarcusFernstrom.com
Re: Semaphore example?
« Reply #9 on: January 07, 2020, 03:37:11 pm »
Thaddy I appreciate that, but I need to have at least Linux (With Windows being a nice addition).

Pascal, thanks for sharing, and this is a stupid question but I've never used semaphores, could you give me an example of how to use it? (Just a copy paste of some code that uses it)

Amir61

  • New Member
  • *
  • Posts: 28
    • http://Amir.Aavani.net
Re: Semaphore example?
« Reply #10 on: December 18, 2024, 06:01:31 am »
@Pascal

Should MaxPermits be InitPermits? The name MaxPermits suggests it is the maximum Wait (Post?) we allow while it looks like this parameter is setting how many calls to Wait can bypass suspension.

 

TinyPortal © 2005-2018