CODEWITHSUNDEEP
delphicallback64-bit32bit-64bit
Palka
Palka

Reputation: 19

Delphi x64: How to pass local procedure as a procedural parameter (callback)

Some years ago I've ported an old unix application to Delphi 5. For linked lists iterations it used local procedures passed by address to a global 'iterator' function.

Below is a simplified example:

type TPerformProc = procedure;

procedure Perform(proc:TPerformProc);
begin
  proc;
end;

procedure Test;
var loc_var:integer;

  procedure loc_proc;
  begin
    loc_var:=loc_var+10;
  end;

begin
  loc_var:=0;
  writeln('loc var: ',loc_var);
  Perform(addr(loc_proc));
  writeln('loc var: ',loc_var);
  writeln('-----');
end;

The example procedure crashes in Delphi, but it worked on unix just fine.

With some help, I've been able to get it working like this:

type TPerformProc = procedure;

var loc_bp:integer;

procedure Perform(proc:TPerformProc);
begin
  asm
    push loc_bp
  end;
  proc;
  asm
    pop eax
  end;
end;

procedure Test;
var loc_var:integer;

  procedure loc_proc;
  begin
    loc_var:=loc_var+10;
  end;

begin
  loc_var:=0;
  writeln('loc var: ',loc_var);
  asm
    mov loc_bp,ebp
  end;
  Perform(addr(loc_proc));
  writeln('loc var: ',loc_var);
  writeln('-----');
end;

To solve the problem, I store a reference to the stack frame of the local procedure and then I call the local procedure.

It's clear to me, that the solution above is not a proper fix, but rather a hack and I understand that a new Delphi version might handle the local procedures in a different way and break the hack. Fortunately enough, this part of Delphi stayed the same and the code works OK even with latest Delhi.

However, I want to compile the application as 64-bit one and the hack is no longer working. So far I was not able to find a similar solution, but for 64-bit. Is here someone who can help here ?

Thank you.

Upvotes: 0

Views: 1106

Answers (3)

Palka
Palka

Reputation: 19

My edit in the original post was rolled back with the request to post it as answer, so here we go.

After further fiddling, following seems to work properly for 32 and 64-bit platform:

type TPerformProc = procedure;

var my_bp:NativeInt;

procedure SimpleFixPerform(proc:TPerformProc);
asm
  {$ifdef WIN64}
    mov rax,proc
    push rbp
    mov rbp,my_bp
    mov rcx,my_bp
    call rax
    pop rbp
  {$else}
    push my_bp
    call proc
    pop eax
  {$endif}
end;

procedure SetupBP;
asm
  {$ifdef WIN64}
    mov my_bp,rbp
  {$else}
    mov my_bp,ebp
  {$endif}
end;

procedure SimpleFixTest;
var loc_var:integer;

  procedure loc_proc;
  begin
    loc_var:=loc_var+10;
  end;

begin
  loc_var:=0;
  loc_proc;
  writeln('SimpleFix var: ',loc_var);
  SetupBP;
  SimpleFixPerform(@loc_proc);
  writeln('SimpleFix var: ',loc_var);
  writeln('-----');
end;

My assembler skills are bit rusted, so if you see a gotcha in code code, please comment

Upvotes: 0

LU RD
LU RD

Reputation: 34899

A variation of @J...'s answer, also using anonymous methods.

program Project163;

{$APPTYPE CONSOLE}

uses
  SysUtils;

procedure Perform(proc:TProc);
begin
  WriteLn('doing something else important...');
  proc;
end;

procedure Test;
var
  loc_var:integer;

  function _LocalProc : TProc;
  begin
    Result :=
      procedure
      begin
        loc_var := loc_var+10;
      end;
  end;

begin
  loc_var:=0;
  writeln('loc var: ',loc_var);
  Perform(_LocalProc());
  writeln('loc var: ',loc_var);
  writeln('-----');
end;

begin
  Test; ReadLn;
end.

The _LocalProc is turned into a function, returning an anonymous method, identical to the original local procedure.

Note the extra paranthesis in the call Perform(_LocalProc()), to make the compiler understand to pass the resulting anonymous method as parameter.

Upvotes: 1

J...
J...

Reputation: 31393

The cleanest solution here is to use anonymous methods. There's no way around this without a bit of refactoring, but you could do it reasonably painlessly like this:

program Project1;    
{$APPTYPE CONSOLE}    
uses
  SysUtils;

procedure Perform(proc:TProc);
begin
  WriteLn('doing something else important...');
  proc;
end;

procedure Test;
var
  loc_var:integer;

  procedure PerformExt;
  begin
    Perform(procedure
            begin
              loc_var := loc_var+10;
            end);
  end;    
begin
  loc_var:=0;
  writeln('loc var: ',loc_var);
  PerformExt;
  writeln('loc var: ',loc_var);
  writeln('-----');
end;    

begin
  Test; ReadLn;
end.

This produces output :

 loc var: 0  
 doing something else important...  
 loc var: 10  
 -----

Note that the definition for Perform has to change to accept a TProc rather than your custom procedure alias.

Upvotes: 1

Related Questions