Kylix 中的 TEvent.WaitFor

Question

在 Kylix 中，TEvent.WaitFor(Timeout) 方法仅接受 $FFFFFFFF 的超时，否则会生成错误。它在内部使用 sem_wait 函数，该函数没有超时参数。有什么办法解决这个问题吗？我需要设置一个超时参数。

Answer 1

sem_timedwait 在 Linux 较旧的线程实现中（LinuxThreads，在 2.4 中引入 NPTL 之前）已被破坏。一些发行版仍然将 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.

Answer 2

在 Google 上搜索“kylix tevent.waitfor”，您会看到有关该问题的各种帖子/讨论，至少可以追溯到 2002 年。我没有详细浏览过它们，但看起来像 http://www.mswil.ch/websvn/filedetails.php?repname=devphp&path=%2Fcomponent%2FIndy9%2FSource%2FIdHL7.pas&sc=1 有修复。

Answer 3

我查看了 FPC 源代码，并使用了基于 pthread_cont_timedwait 的更新函数，

请参见例如 http://svn.freepascal.org/cgi-bin/viewvc.cgi/trunk/rtl/unix/cthreads.pp?view=markup
大约第 750 行

（过程 intBasiceventwaitfor 和 intRTLEventWaitForTimeout 这些是各种 .waitfor 函数的原语）

可能这只是 Kylix 显示其年龄。