Zwei Threads wollen etwas in die Queue stopfen

[TiGü]

Zitat von einbeliebigername:

Setze mal bitte zum testen ShereMem in beiden Projekten an oberster Stelle. Und dann lass den Cast TArray<Integer>(AData) weck und änder die Signatur, so das beide Seiten wissen, dass dort ein Dynamisches Array übergeben wird.

Das hat auf jeden Fall eine Verbesserung gebracht bzw. ich konnte mit dieser Methode kein Problem in den sechs Probeläufen feststellen.
Aber da die Lösung dann speziell auf mit Delphi erzeugte Programme zugeschnitten ist, bin ich damit nicht sehr zufrieden.
Ich will mir nicht die Möglichkeit verbauen mit einen C++ oder .NET-Clienten ggf. die Daten aus der DLL abzuholen.

Ich "queue" nun selbst, indem ich im Formular die Daten temporär zwischenhalte und im Application.OnIdle abhole.
Prinzipell das gleiche wie mit TThread.Queue oder .Synchronize, nur mit weniger Overhead.
Wenn jemand eine bessere Idee hat, nur raus damit.

Delphi-Quellcode:

unit QueueFrm;

interface

uses
  Winapi.Windows, Winapi.Messages,
  System.SysUtils, System.Variants, System.Classes, System.SyncObjs, System.Generics.Collections,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,
  Data.Consumer.Intf;

type
  TDataConsumerFrm = class(TForm, IDataConsumer)
    btnStart: TButton;
    mmoLog: TMemo;
    procedure btnStartClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    FQueue: TQueue<Integer>;
    procedure ShowData;
    procedure LogToMemo(const ADataStr: string);
  public
    procedure GetDataOnIdle(Sender: TObject; var Done: Boolean);
    procedure Notify(const AData: Pointer; const ADataCount: Cardinal); stdcall;
  end;

var
  DataConsumerFrm: TDataConsumerFrm;

procedure SubscribeConsumer(const ADataConsumer: IDataConsumer); stdcall; external 'QueueDLL.dll';

implementation

{$R *.dfm}

{ TDataConsumerFrm }

procedure TDataConsumerFrm.btnStartClick(Sender: TObject);
begin
  SubscribeConsumer(Self);
end;

procedure TDataConsumerFrm.FormCreate(Sender: TObject);
begin
  FQueue := TQueue<Integer>.Create;
  TThread.NameThreadForDebugging('VCL-MainThread', MainThreadID);
  Application.OnIdle := GetDataOnIdle;
end;

procedure TDataConsumerFrm.FormDestroy(Sender: TObject);
begin
  SubscribeConsumer(nil);
  FQueue.Free;
end;

procedure TDataConsumerFrm.GetDataOnIdle(Sender: TObject; var Done: Boolean);
var
  LValue: Integer;
begin
  ShowData;
end;

procedure TDataConsumerFrm.Notify(const AData: Pointer; const ADataCount: Cardinal);
var
  LDataPtr: PInteger;
  LValue: Integer;
  I: Integer;
begin
  System.TMonitor.Enter(FQueue);
  try
    if Assigned(AData) and (ADataCount > 0) then
    begin
      LDataPtr := AData;
      for I := 0 to ADataCount - 1 do
      begin
        LValue := PInteger(LDataPtr)^;
        FQueue.Enqueue(LValue);
        Inc(LDataPtr);
      end;
    end;
  finally
    System.TMonitor.Exit(FQueue);
  end;
end;

procedure TDataConsumerFrm.ShowData;
var
  LValue: Integer;
  LDataStr: string;
begin
  System.TMonitor.Enter(FQueue);
  try
    while FQueue.Count > 0 do
    begin
      LValue := FQueue.Dequeue;
      LDataStr := LValue.ToString;
      LogToMemo(LDataStr);
    end;
  finally
    System.TMonitor.Exit(FQueue);
  end;
end;

procedure TDataConsumerFrm.LogToMemo(const ADataStr: string);
begin
  mmoLog.Lines.Add(ADataStr);

  if mmoLog.Lines.Count > 5000 then
  begin
    mmoLog.Lines.Clear;
  end;
end;

end.