Recent

Author Topic: Semaphore example?  (Read 1211 times)

Trenatos

  • Hero Member
  • *****
  • Posts: 524
    • 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: 524
    • 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: 2116
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: 524
    • 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: 2594
  • 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: 10684
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.

Pascal

  • Hero Member
  • *****
  • Posts: 919
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 (2004)

Trenatos

  • Hero Member
  • *****
  • Posts: 524
    • 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)

 

TinyPortal © 2005-2018