On Tue, Apr 14, 2009 at 1:42 PM, Michael Van Canneyt
<mich...@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/
_______________________________________________
fpc-pascal maillist - fpc-pascal@lists.freepascal.org
http://lists.freepascal.org/mailman/listinfo/fpc-pascal
