sem_timedwait не работает в старых реализациях потоков Linux (LinuxThreads, до введения NPTL в 2.4). Некоторые дистрибутивы по-прежнему связывают исполняемые файлы Kylix с этими более старыми библиотеками как прокладки обратной совместимости, потому что Kylix не содержит информацию о версии, которую ожидает компоновщик. FreePascal не имеет этой проблемы, потому что он содержит информацию о версии, поэтому он всегда связан с более новыми библиотеками потоков.
Мы решили эту проблему, опросив и уснув. Это не красиво и не эффективно, но это полная замена TEvent.WaitFor:
var
IsPThreadsBroken: Boolean;
function TEvent.WaitFor(Timeout: LongWord): TWaitResult;
{$IFDEF MSWINDOWS}
begin
case WaitForSingleObject(Handle, Timeout) of
WAIT_ABANDONED: Result := wrAbandoned;
WAIT_OBJECT_0: Result := wrSignaled;
WAIT_TIMEOUT: Result := wrTimeout;
WAIT_FAILED:
begin
Result := wrError;
FLastError := GetLastError;
end;
else
Result := wrError;
end;
{$ENDIF}
{$IFDEF LINUX}
const
NanoPerSec = 1000000000;
NanoPerMilli = 1000000;
MilliPerSec = 1000;
function sem_timedpollwait(var __sem: TSemaphore; const __abstime: timespec): Integer;
function Elapsed(Current: TTimespec; Target: TTimespec): Boolean;
begin
Result := False;
if (Current.tv_sec > Target.tv_sec) or
((Current.tv_sec = Target.tv_sec) and (Current.tv_nsec >= Target.tv_nsec)) then
Result := True;
end;
var
CurrentTime, SleepTime: TTimespec;
SemResult: Integer;
begin
Result := 0;
//Try and grab the semaphore.
if sem_trywait(FEvent)= 0 then
SemResult := 0
else
SemResult := errno;
if (SemResult = EAGAIN) then
begin
//not grabbed, wait a little while and try again.
clock_gettime(CLOCK_REALTIME, CurrentTime);
while (not Elapsed(CurrentTime, __abstime)) and (SemResult = EAGAIN) do
begin
SleepTime.tv_sec := 0;
SleepTime.tv_nsec := NanoPerMilli; //sleep for ~1millisecond.
if nanosleep(SleepTime, @CurrentTime) <> 0 then
SemResult := errno
else if sem_trywait(FEvent) = 0 then
SemResult := 0
else begin
SemResult := errno;
clock_gettime(CLOCK_REALTIME, CurrentTime);
end;
end;
end;
//we waited and still don't have the semaphore, time out.
if SemResult = EAGAIN then
Result := ETIMEDOUT
// else some other error occured.
else if SemResult <> 0 then
Result := EINTR;
end;
var
WaitResult: Integer;
abs_timeout: TTimeSpec;
begin
Result := wrError;
if (Timeout <> LongWord($FFFFFFFF)) and (Timeout <> 0) then begin
if clock_gettime(CLOCK_REALTIME, abs_timeout) <> 0 then
Exit;
Inc(abs_timeout.tv_sec, Timeout div MilliPerSec);
Inc(abs_timeout.tv_nsec, (Timeout mod MilliPerSec) * NanoPerMilli);
if abs_timeout.tv_nsec >= NanoPerSec then
begin
Inc(abs_timeout.tv_sec);
Dec(abs_timeout.tv_nsec, NanoPerSec);
end;
end;
{ Wait in a loop in case the syscall gets interrupted by GDB during debugging }
repeat
if Timeout = LongWord($FFFFFFFF) then
WaitResult := sem_wait(FEvent)
else if Timeout = 0 then
WaitResult := sem_trywait(FEvent)
else
begin
if IsPThreadsBroken then
WaitResult := sem_timedpollwait(FEvent, abs_timeout)
else
WaitResult := sem_timedwait(FEvent, abs_timeout);
end
until (Result <> wrError) or (errno <> EINTR);
if WaitResult = 0 then
begin
Result := wrSignaled;
if FManualReset then
begin
FEventCS.Enter;
try
{ the event might have been signaled between the sem_wait above and now
so we reset it again }
while sem_trywait(FEvent) = 0 do {nothing};
sem_post(FEvent);
finally
FEventCS.Leave;
end;
end;
end
else if (errno = EAGAIN) or (errno = ETIMEDOUT) then
Result := wrTimeout
else
Result := wrError;
{$ENDIF}
end;
const
_CS_GNU_LIBC_VERSION = 2;
_CS_GNU_LIBPTHREAD_VERSION = 3;
var
Len: size_t;
ThreadLib: string;
initialization
IsPThreadsBroken := True;
Len := confstr(_CS_GNU_LIBPTHREAD_VERSION, nil, 0);
if Len > 0 then begin
SetLength(ThreadLib, Len - 1);
confstr(_CS_GNU_LIBPTHREAD_VERSION, PChar(ThreadLib), Len);
IsPThreadsBroken := Pos('linuxthreads', ThreadLib) <> 0
end;
end.