On Mon, 16 May 2016 08:42:22 -0400, Dmitry Boyarintsev
<skalogryz.li...@gmail.com> wrote:
>On Mon, May 16, 2016 at 6:22 AM, Bo Berglund <bo.bergl...@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
_______________________________________________
fpc-pascal maillist - fpc-pascal@lists.freepascal.org
http://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-pascal
