[fpc-pascal] What to use when porting WaitForMultipleObjects to Linux?

Bo Berglund bo.berglund at gmail.com
Mon May 16 15:01:32 CEST 2016


On Mon, 16 May 2016 08:42:22 -0400, Dmitry Boyarintsev
<skalogryz.lists at gmail.com> wrote:

>On Mon, May 16, 2016 at 6:22 AM, Bo Berglund <bo.berglund at gmail.com> wrote:
>
>> When porting a Delphi console program on Windows to FreePascal on
>> Linux, what can one do with API calls like WaitForMultipleObjects,
>> which is used to synchronize processing between threads?
>>
>
>It depends if you're actually using WaitForMultipleObjects to sync with
>*multiple* objects.


I should have included an example...
Below is an excerpt of a TThread desdcendant used to handle the data
in and out of a TIdTcpClient object.

The Execute procedure handles everything going on and it acts on event
signals picked up (I believe) by the WaitForMultipleObjects calls.

What I would like to know is how exactly to handle this in FreePascal
on Linux....


---- Code snippets follow ------
type
  TSSRxEvent = procedure (const Buffer: TIdBytes) of object;
...
  TSSCommThread = class(TThread)
  private
    FClient: TIdTCPClient;
    FTxBufferLock: TCriticalSection;
...
    FOnRxData: TSSRxEvent;
...

procedure TSSCommThread.Execute;
{While the client is connected this procedure will handle the incoming
data}
var
  LBuffer: TIdBytes;
  LConnectEvents: array[0..2] of THandle;
  LDisconnectEvents: array[0..1] of THandle;
  LDataTransmitEvents: array[0..0] of THandle;
  LSignaledEvent: THandleObject;
  Ret: DWORD;
begin
  LConnectEvents[0] := FConnectEvent.Handle;
  LConnectEvents[1] := FDisconnectEvent.Handle;
  LConnectEvents[2] := FTerminateEvent.Handle;

  LDisconnectEvents[0] := FDisconnectEvent.Handle;
  LDisconnectEvents[1] := FTerminateEvent.Handle;

  LDataTransmitEvents[0] := FTransmitEvent.Handle;

  while not Terminated do
  begin
    Ret := WaitForMultipleObjects(3, PWOHandleArray(@LConnectEvents),
False, INFINITE);
    if (Ret >= WAIT_OBJECT_0) and (Ret < (WAIT_OBJECT_0 + 3)) then
      Dec(Ret, WAIT_OBJECT_0)
    else
      Exit;
    if Terminated or (LSignaledEvent = FTerminateEvent) then Exit;
    if LSignaledEvent = FDisconnectEvent then
    begin
      FDisconnectEvent.ResetEvent;
      FDisconnectedEvent.SetEvent;
      Continue;
    end;
    if LSignaledEvent = FConnectEvent then
    begin
      FDisconnectedEvent.ResetEvent;
      try
        FClient.Connect;
        try
          if Assigned(FOnConnect) then
            FOnConnect();
          while (WaitForMultipleObjects(2,
PWOHandleArray(@LDisconnectEvents), False, 0) = WAIT_TIMEOUT) do
          begin
            // TODO: check pending queue for outgoing data..
            if FTransmitEvent.WaitFor(0) = wrSignaled then
            begin
              FTxBufferLock.Enter;
              try
                LBuffer := FTxBuffer;
                FTxBuffer := nil;
                FTransmitEvent.ResetEvent;
              finally
                FTxBufferLock.Leave;
              end;
              FClient.IOHandler.Write(LBuffer);
            end;

            // Check for incoming data
            if FClient.IOHandler.CheckForDataOnSource(10) then
            begin
              SetLength(LBuffer, 0);
              FClient.IOHandler.ReadBytes(LBuffer, -1, false);
              if Length(LBuffer) > 0 then
              begin
                // TODO: add data to a thread-safe receive queue
                if Assigned(FOnRxData) then
                  FOnRxData(LBuffer);
              end;
            end;
          end;
        finally
          FClient.Disconnect;
          FDisconnectedEvent.SetEvent;
          if Assigned(FOnDisconnect) then
            FOnDisconnect();
        end;
      except
        on E: Exception do
        begin
          if Assigned(FOnError) then
            OnError(E.Message);
          WaitForMultipleObjects(2,
PWOHandleArray(@LDisconnectEvents), False, 5000);
        end;
      end;
    end
  else
      Exit;
  end;
end;

procedure TSSCommThread.Stop;
begin
  Terminate;
  FTerminateEvent.SetEvent;
end;

procedure TSSCommThread.Send(Buffer: TIdBytes; BufLen: Integer);
var
  Idx: Integer;
begin
  // TODO: add data to a thread-safe transmit queue, signal event that
data is waiting
  if BufLen > 0 then
  begin
    FTxBufferLock.Enter;
    try
      Idx := Length(FTxBuffer);
      SetLength(FTxBuffer, Idx + BufLen);
      Move(Buffer[0], FTxBuffer[Idx], BufLen);
      FTransmitEvent.SetEvent;
    finally
      FTxBufferLock.Leave;
    end;
  end;
end;

...


-- 
Bo Berglund
Developer in Sweden




More information about the fpc-pascal mailing list