[fpc-pascal] semaphores?

Graeme Geldenhuys graemeg.lists at gmail.com
Tue Apr 14 14:38:57 CEST 2009


On Tue, Apr 14, 2009 at 1:42 PM, Michael Van Canneyt
<michael at freepascal.org> wrote:
>
> Use GetThreadManager() to retrieve the thread manager, and then
> simply use the various functions.

Umm, I didn't know that... I made a note for future reference. :-)


> This should work cross-platform, but it seems that the Windows
> implementation is empty. Maybe we can use your functions to
> implement the windows part.

The code I quoted is from tiOPF's tiPool.pas unit.  I think the
following is the relevant parts...

================================
procedure TtiPool.UnlockPoolSemaphore;
begin
  {$IFDEF MSWINDOWS}
  ReleaseSemaphore(FSemaphore, 1, nil);
  {$ENDIF MSWINDOWS}
  {$IFDEF LINUX}
  if sem_post(FSemaphore) <> 0 then
    raise Exception.Create('Failed to unlock the semaphore');
  {$ENDIF LINUX}
end;

procedure TtiPool.CreatePoolSemaphore;
begin
  {$IFDEF MSWINDOWS}
  if FSemaphore <> 0 then
    CloseHandle(FSemaphore);
  FSemaphore := CreateSemaphore(nil, FMaxPoolSize, FMaxPoolSize, nil);
  {$ENDIF MSWINDOWS}
  {$IFDEF LINUX}
  sem_destroy(FSemaphore);
  if sem_init(FSemaphore, 0, FMaxPoolSize) <> 0 then
    raise Exception.Create('Failed to create the semaphore');
  {$ENDIF LINUX}
end;

procedure TtiPool.DestroyPoolSemaphore;
{$IFDEF LINUX}
var
  error: integer;
{$ENDIF LINUX}
begin
  {$IFDEF MSWINDOWS}
  CloseHandle(FSemaphore);
  {$ENDIF MSWINDOWS}
  {$IFDEF LINUX}
  error := sem_destroy(FSemaphore);
  if error <> 0 then
    raise Exception.Create('Failed to destroy the semaphore');
  {$ENDIF LINUX}
end;

function TtiPool.LockPoolSemaphore: boolean;
begin
  // Wait for a semaphore
  {$IFDEF MSWINDOWS}
  result:= WaitForSingleObject(FSemaphore, FWaitTime * 1000) <> WAIT_TIMEOUT;
  {$ENDIF MSWINDOWS}
  {$IFDEF LINUX}
  { TODO: The timeout option is not available in POSIX semaphores. This can be
    achieved by issuing a non-blocking sem_trywait() within a loop, which
    counts the timeout value: int sem_trywait(sem_t * sem).
    i := fpgeterrno; }
  result:= sem_trywait(FSemaphore) = 0;
  {$ENDIF LINUX}
end;

============================

The tiPool.pas unit is probably the unit with the most IFDEF's in
them, in the whole tiOPF project. ;-)


Regards,
  - Graeme -


_______________________________________________
fpGUI - a cross-platform Free Pascal GUI toolkit
http://opensoft.homeip.net/fpgui/



More information about the fpc-pascal mailing list