[gelöst] procedure als datentyp

[juelin]

hi,
ich habe ein Programm, indem ich eine procedure als Variblentyp übergeben muss.

Code: Alles auswählen

in include File
type
  Trtlsdr_read_async_cb_t = procedure(buf: pbyte; len: Tuint32_t; ctx: pointer); cdecl;

Programm
  var
    hu: ^byte;
    hw: Trtlsdr_read_async_cb_t;
    hx: pbyte;
    hy: Tuint32_t;
    hz: pointer;
    buffer: pointer;
    Daten_Len: Tuint32_t;
    Daten_Adr: pointer;
    
procedure TForm1.rtlsdr_callback(buf: pbyte; len: Tuint32_t; ctx: pointer);
begin
  Daten_Len:=len;
  Daten_Adr:=ctx;
  move(buffer, buf, len);
end;
    
procedure main_program;
begin
    GetMem(buffer, 262144 * sizeof(byte));
    hx:=hu;
    hy:=262144;
    hz:=buffer;
    hw:=rtlsdr_callback(hx, hy, hz);   // Zeile wo der Fehler auftritt Zeile 254
end;    
 

Da kommt folgende Fehlermeldung vom Compiler:
Nachrichten, Warnungen: 1
Warning: other unit files search path (aka unit path) of "ADS-B" contains "c:\Lazarus\components\codetools", which belongs to package "CodeTools"
Hint: (11030) Start of reading config file C:\lazarus\fpc\3.2.2\bin\x86_64-win64\fpc.cfg
Hint: (11031) End of reading config file C:\lazarus\fpc\3.2.2\bin\x86_64-win64\fpc.cfg
Free Pascal Compiler version 3.2.2 [2025/01/19] for x86_64
Copyright (c) 1993-2021 by Florian Klaempfl and others
(1002) Target OS: Win64 for x64
(3104) Compiling adsb.lpr
(3104) Compiling unit1.pas
E:\RTLSDR\adsb\unit1.pas(254,7) Error: (4001) Incompatible types: got "untyped" expected "<procedure variable type of procedure(PByte;LongWord;Pointer);CDecl>"
unit1.pas(637) Fatal: (10026) There were 1 errors compiling module, stopping
Fatal: (1018) Compilation aborted
Error: C:\lazarus\fpc\3.2.2\bin\x86_64-win64\ppcx64.exe returned an error exitcode

Wie bekomme ich die procedure rtlsdr_callback in die Variable hw????

Danke und Gruß
Jürgen

[theo]

Das hatte ich dir teilweise schon im anderen (geschlossenen??) Thread erklärt:
viewtopic.php?p=150780#p150780

Code: Alles auswählen

procedure rtlsdr_callback(buf: pbyte; len: Tuint32_t; ctx: pointer); cdecl;
begin
...
end;
...
var  hw: Trtlsdr_read_async_cb_t;
begin
   hw:=@rtlsdr_callback;
   hw(nil,3,nil); //test
end;     

[juelin]

Danke Theo.

leider bekomme ich bei dem Befehl hw:=@rtlsdr_callback;
die gleiche Fehlermeldung wie oben.
unit1.pas(254,7) Error: Incompatible types: got "<procedure variable type of procedure(PByte;LongWord;Pointer) of object;Register>" expected "<procedure variable type of procedure(PByte;LongWord;Pointer);CDecl>"

Gruß
Jürgen

[theo]

Nein, das ist nicht die gleiche Meldung.
Du hast wohl meinen Prozedurheader nicht 1:1 kopiert.
Es geht nur so, wie in meinem Beispiel. TForm1.rtlsdr_callback(..) geht nicht!!!

[Mathias]

Eines kann ich vorweg sagen, das dies nicht geht, du kannst keine Methode, welche in einer Pascal Klasse sind, direkt an eine C-Methode übergeben.
Ich nehme mal an, du willst hw an rtlsdr_wait_async oder rtlsdr_read_async übergeben ?

Code: Alles auswählen

procedure TForm1.rtlsdr_callback(buf: pbyte; len: Tuint32_t; ctx: pointer);
begin
...
end;
    
procedure main_program;
begin
 ....
    hw:=rtlsdr_callback(hx, hy, hz);   // Zeile wo der Fehler auftritt Zeile 254
end;    

Nachtrag:
Das ganze muss in etwas so aussehen:

Code: Alles auswählen

type
  TRtsClass = class(TObject)
    constructor Create;
    procedure Ausgabe;
  end;

  procedure call_cp(buf: pbyte; len: Tuint32_t; ctx: pointer); cdecl;
  var
    rtsclass: TRtsClass absolute ctx;
  begin
    rtsclass.Ausgabe;
  end;

  constructor TRtsClass.Create;
  var
    dev: Prtlsdr_dev_t=nil;
  begin
    // Hier rts inizialisieren
    rtlsdr_wait_async(dev, @call_cp, self);
  end;

  procedure TRtsClass.Ausgabe;
  begin
    WriteLn('Ausgabe');
  end;


var
  rts: TRtsClass;

begin
  rts:=TRtsClass.Create;

  rts.Free;
end.                                                     

[theo]

@Mathias: Mach's nicht noch komplizierter.

[Warf]

Pascal unterscheidet Grundsätzlich 3 typen von Funktionen (und damit auch Funktionspointern) basierend auf Kontext:
1. Reguläre funktionen: Diese haben keinen Kontext und sind nichts anderes als ein stück Code zu dem gesprungen werden kann:

Code: Alles auswählen

procedure NormalProc;
begin
  WriteLn('Normal Proc');
end;

var
  p: procedure;
begin
  p:=@NormalProc;
  p();
end.

2. Verschachtelte Funktionen, die können auf den Kontext der Definierenden funktion (lokale Variablen, Parameter, etc.) zugreifen, und dafür bekommen sie intern einen pointer zu dem Stackframe der Vaterfunktion übergeben

Code: Alles auswählen

{$ModeSwitch nestedprocvars}

procedure Test;
var
  localVar: Integer;

procedure Nested;
begin
  WriteLn('Ich kann auf localVar zugreifen: ', localVar);
end;

var
  p: procedure is nested;
begin
  localVar:=42;
  p:=@Nested;
  p();
end;

Pointer auf Nested Funktionen darfst du nur aufrufen solang der Stackframe der Vaterfunktion noch aktiv ist, sonst sind die Daten aus dem Kontext weg.
3. Methoden: Funktionen im Kontext einer Klasse oder Metaklasse:

Code: Alles auswählen

{$mode objfpc}{$H+}

type
  TTest = class
  public
    Field: Integer;
    procedure Method;
  end;

procedure TTest.Method;
begin
  WriteLn('Ich hab zugriff auf alle Member der Klasse: ', Field);
end;

var
  t: TTest;
  p: procedure of object;
begin
  t:=TTest.Create;
  t.Field:=42;
  p:=@t.Method;
  p();
end.

Methodenpointer darfst du nur aufrufen solang das Objekt von dem du die Methode genommen hast noch am leben ist, sonst ist der Kontext weg.


Dein Problem ist jetzt, du hast den Funktionspointer für eine Reguläre Funktion definiert, versuchst ihm aber eine Methode zuzuweisen. Das geht natürlich nicht

[juelin]

Ja Danke Theo.
It halt für mich das erste mal, dass ich mit so einem Datentyp arbeite
und habe auf dem Gebiet noch keine Erfahrung.

Muss dicj aber noch was frage.
Mein Programm:

Code: Alles auswählen

  var
      buffer: pointer;
      he: Trtlsdr_read_async_cb_t;

procedure rtlsdr_callback(buf: pbyte; len: Tuint32_t; ctx: pointer); cdecl;
begin
  Daten_Len:=len;
  Daten_Adr:=ctx;
  move(buffer, buf, len);   // hier kommt die Fehlermeldung
end;

  he:=@rtlsdr_callback;
  he(nil,3,self);
  h1:=rtlsdr_read_async(sdropennum, he, buffer, DEFAULT_ASYNC_BUF_NUMBER, DEFAULT_BUF_LENGTH);

// der Aufruf rtl_read_async ist folgendermaßen definiert:
// function rtlsdr_read_async(dev: Prtlsdr_dev_t; cb: Trtlsdr_read_async_cb_t; ctx: pointer; buf_num: Tuint32_t; buf_len: Tuint32_t): longint; cdecl; external librtlsdr;

Fehlermeldung siehe Anhang bild1
in C ist die procedure rtlsdr_callback folgendermaßen definiert

Code: Alles auswählen

static void rtlsdr_callback(unsigned char *buf, uint32_t len, void *ctx)
{
	if (do_exit) {
		return;}
	memcpy(buffer, buf, len);
	safe_cond_signal(&ready, &ready_m);
}

Danke für die Hilfe.
Wenn ich könnte würde ich Dir einen ausgeben (Vielleicht klappt es ja mal z.B. Lazaruskonferenz).
Gruß
Jürgen

[juelin]

Ja Danke Theo.
It halt für mich das erste mal, dass ich mit so einem Datentyp arbeite
und habe auf dem Gebiet noch keine Erfahrung.

Muss dich aber noch was frage.
Mein Programm:

Code: Alles auswählen

  var
      buffer: pointer;
      he: Trtlsdr_read_async_cb_t;

procedure rtlsdr_callback(buf: pbyte; len: Tuint32_t; ctx: pointer); cdecl;
begin
  Daten_Len:=len;
  Daten_Adr:=ctx;
  move(buffer, buf, len);   // hier kommt die Fehlermeldung
end;

  he:=@rtlsdr_callback;
  he(nil,3,self);
  h1:=rtlsdr_read_async(sdropennum, he, buffer, DEFAULT_ASYNC_BUF_NUMBER, DEFAULT_BUF_LENGTH);

// der Aufruf rtl_read_async ist folgendermaßen definiert:
// function rtlsdr_read_async(dev: Prtlsdr_dev_t; cb: Trtlsdr_read_async_cb_t; ctx: pointer; buf_num: Tuint32_t; buf_len: Tuint32_t): longint; cdecl; external librtlsdr;

Fehlermeldung siehe Anhang bild1
in C ist die procedure rtlsdr_callback folgendermaßen definiert

Code: Alles auswählen

static void rtlsdr_callback(unsigned char *buf, uint32_t len, void *ctx)
{
	if (do_exit) {
		return;}
	memcpy(buffer, buf, len);
	safe_cond_signal(&ready, &ready_m);
}

Danke für die Hilfe.
Wenn ich könnte würde ich Dir einen ausgeben (Vielleicht klappt es ja mal z.B. Lazaruskonferenz).
Gruß
Jürgen

[juelin]

Kann es sein, dass in Pascal buf als pbyte definiert ist
und in C als unsigned char??

Habe mal debugt:
in buf steht "nil" drin.
in len steht 3 drin
und in ctx steht halt eine Speicheradresse drin.

[Mathias]

Eines vorweg memcpy und move werden anders aufgerufen.

Wen du es gleich habe willst mache eine Bindung zu memcpy. Oder machst es Pascal Konform.

Code: Alles auswählen

const
  {$IFDEF Linux}
  libclib = 'c';
  {$ENDIF}

  {$IFDEF windows}
  libclib = 'msvcrt';
  {$ENDIF}

  function memcpy(dest, src: Pointer; n: SizeUInt): Pointer; cdecl; external libclib;   

@Mathias: Mach's nicht noch komplizierter.

Hast du eine bessere Idee, wen du es in eine Pascal Klasse kapseln willst.

[juelin]

Hallo,
nochmals recht herzlichen Dank für Eure Unterstützung.
Der Hinweis auf memcpy war genau richtig.
Jetzt läuft mein Programm endlich.
Na ja, war für mich Neuland.
Aber was uns nicht umbringt macht uns nur stärker.
Also nochmal Danke.
Wenn ich fertig bin werde ich als kleines Dankeschön
das Programm veröffentlichen.
Bis dann und 73
Jürgen