Hallo miteinander,

ich habe wieder ein merkwürdiges Problem und suche jemanden, der mir den Knoten im Kopf löst.
Ich habe mein Problem auf ein kleines Testprojekt reduzieren können (siehe Anhang). Es besteht aus einen Formular mit einen Start-Button und einen Memo.
Es ist mit DX erstellt, sollte sich aber so auch in jeder Version größer XE2 öffnen lassen?!

Problembeschreibung:
In einer DLL laufen zwei Threads, die Daten produzieren und per Callback an das Hauptprogramm übertragen.
Da die Callback im Kontext des Threads aufgerufen wird, verbietet sich hier natürlich der direkte Zugriff auf Member des VCL-Mainthreads.
Daher stopfe ich die übergebenden Daten per TThread.Queue in die Warteschlange.

zusammenfalten · markieren

Delphi-Quellcode:

procedure TDataConsumerFrm.Notify(const AData: Pointer; const ADataCount: Cardinal);
var
  LArray: TArray<Integer>;
begin
  FLock.Enter;
  try
    if Assigned(AData) and (ADataCount > 0) then
    begin
      LArray := Copy(TArray<Integer>(AData), 0, ADataCount);

      TThread.Queue(nil,
        procedure
        begin
          ShowData(LArray);
        end);
    end;
  finally
    FLock.Leave;
  end;
end;

Nach kurzer Laufzeit erhalte ich dann merkwürdige Zugriffsverletztungen, die ich mir so nicht erklären kann, da es ja eine zeitlang gut geht.

markieren

Code:

Project QueueTestProject.exe raised exception class $C0000005 with message 'access violation at 0x00000000: read of address 0x00000000'.
Project QueueTestProject.exe raised exception class EInvalidPointer with message 'Invalid pointer operation'.

Callstacks:

markieren

Code:

System._IntfCopy(???,???)
:0040cfbd @IntfCopy + $9
QueueFrm.TDataConsumerFrm.Notify($2D828E8,4)
QueueDLL.{Data.Producer.Impl}TDataProducer<System.Integer>.SendNotify
...

System.TObject.Create
QueueDLL.{Data.Producer.Impl}TDataProducer<System.Integer>.SendNotify
QueueDLL.{Data.Producer.Impl}TDataProducer<System.Integer>.Produce
...

System.SysGetMem(???)
:00405571 SysGetMem + $3D
:0116d3b6 {Data.Producer.Impl}TDataProducer<System.Integer>.SendNotify + $86
...

:7502c42d KERNELBASE.RaiseException + 0x58
System._Dispose(???,???)
System.ErrorAt(92,$40B05C)
System.Error(reInvalidPtr)
System._Dispose(???,???)
:0040b05c @Dispose + $C
Vcl.Forms.TApplication.WndProc((0, 0, 0, 0, 0, 0, (), 0, 0, (), 0, 0, ()))
System.Classes.StdWndProc(14223452,0,0,0)
:758862fa ; C:\Windows\syswow64\USER32.dll
...

Irgendwie klappt irgendwann das umkopieren der empfangenden Daten in das lokale LArray nicht mehr. Fragmentiere ich den Speicher zu sehr?
Über jeden Denkanstoß wäre ich dankbar.

Zitat von TiGü:

Irgendwie klappt irgendwann das umkopieren der empfangenden Daten in das lokale LArray nicht mehr. Fragmentiere ich den Speicher zu sehr?
Über jeden Denkanstoß wäre ich dankbar.

Der Thread.Queue() erlaubt, das die aufrufender Notify methode weiter augeführt wird, und wartet nicht auf dessen Ausführung. D.h. dein FLock.Leave und auch das Dispose deiner lokalen var LArray kann bereits erfolgt sein, bevor der Queue Aufruf stattfand.
Versuche es bitte mal mit TThread.Synchronize(nil, ...). Der warte solange, bis es durchgeführt wurde.

Ein Dispose erfolgt nicht, denn die Variable ist im Scope der Anonymen Methode.

Den Lock kann man sich hier komplett sparen ... was soll denn hier überhaupt gelockt werden?

Hm, das sieht mit Synchronize schon besser aus...aber auch hier treten sporadisch die merkwürdigen Effekte auf.
Mal kann so ein Durchlauf minutenlang ohen Fehler durchlaufen und beim nächsten Programstart braucht es nur wenige hundert Daten, um wieder Zugriffsverletzungen zu erzeugen...hm, ich werde noch irre.

Zitat von Sir Rufo:

Den Lock kann man sich hier komplett sparen ... was soll denn hier überhaupt gelockt werden?

Die Notify-Methode im Formular wird von zwei verschiedenen Threads aus der DLL aufgerufen.
Ist das dann nicht notwendig?

Zitat von Sir Rufo:

Ein Dispose erfolgt nicht, denn die Variable ist im Scope der Anonymen Methode.

Sicher? Das ist eine lokale var der Notify Methode. Wenn die beendet ist, werden diese aufgeräumt.
Ist die anonyme Methode bis dahin noch nicht fertig, kann sie auf diese nicht mehr zugreifen.

Zitat von Bambini:

Sicher? Das ist eine lokale var der Notify Methode. Wenn die beendet ist, werden diese aufgeräumt.
Ist die anonyme Methode bis dahin noch nicht fertig, kann sie auf diese nicht mehr zugreifen.

Das stimmt nicht, Variablenbindung ist eines der Hauptmerkmale von anonymen Methoden.

Hallo,

mir ist da was aufgefallen. Es muss nicht das Multithreaded sein. Es könnte auch das Hin- und Her-reichen von dynamischen Arrays in/aus einer DLL für das Problem verantwortlich sein. Du verwendest in deinem Beispiel weder ShareMem noch Vergleichbares.

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.

einbeliebigername.

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.

zusammenfalten · markieren

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.