TEvent.WaitFor in Kylix

Question

In Kylix TEvent.WaitFor(Timeout) method only accepts Timeout of $FFFFFFFF, otherwise it generates an error. Internally it uses sem_wait function which doesn't have a timeout parameter. It there any way around this? I need to set a timeout parameter.

Answer 1

Search Google for "kylix tevent.waitfor" and you'll see various postings/discussions going back to at least 2002 regarding the problem. I haven't browsed them in detail, but it looks like http://www.mswil.ch/websvn/filedetails.php?repname=devphp&path=%2Fcomponent%2FIndy9%2FSource%2FIdHL7.pas&sc=1 has a fix.

Answer 2

I've looked in the FPC source, and newer functions are used, based on pthread_cont_timedwait

See e.g. http://svn.freepascal.org/cgi-bin/viewvc.cgi/trunk/rtl/unix/cthreads.pp?view=markup around line 750

(procedure intBasiceventwaitfor and intRTLEventWaitForTimeout these are primitives for various .waitfor functions )

Probably this is simply Kylix showing its age.

Answer 3

sem_timedwait is broken in Linux's older thread implementations (LinuxThreads, prior to the introduction of NPTL in 2.4). Some distributions still link Kylix executables against those older libraries as backwards compatibility shims, because Kylix doesn't include version information the linker expects. FreePascal doesn't have this problem because it does include the version info, so it's always linked against the newer thread libraries.

We worked around the issue by polling and sleeping. It's not pretty or efficient, but it is a drop-in replacement for 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.