0

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.

David Heffernan
  • 601,492
  • 42
  • 1,072
  • 1,490
Palka
  • 19
  • 2
  • You should implement this using an anonymous method. Then no hacks are needed. – David Heffernan Feb 26 '20 at 11:09
  • If you skip `Addr`, you get a nice error message. My 10.3 compiler says "E2094 Local procedure/function 'loc_proc' assigned to procedure variable". Likely, the best minimal-effort solution would be to use anonymous methods, as @DavidHeffernan suggested. – Andreas Rejbrand Feb 26 '20 at 11:09
  • guys, I know this is officially not supported, however I'm looking for a hack how to make it work. I agree, that anonymous methods are a possible solution (however it was not an option back in the days of Delphi 5), however the usage of local procedures for callback is used very often (1200+ times) so you can imagine how long would it take to convert it to anonymous methods. – Palka Feb 26 '20 at 12:20
  • @David David, I have just noticed you closed this question and marked it as a duplicate of another one. This is not correct, please reopen it. I'm well aware of the fact, that what I'm asking is officially not supported - however there is an unsupported solution for 32-bit (see my example) and maybe there is one for 64-bit - and this is actually what I'm looking for – Palka Feb 26 '20 at 12:45
  • There will be a hack, you'll need to inspect the asm to see how the hidden extra parameter that such methods require is passed in x64. Won't be hard. What will be hard will be converting all the places where you do this hack. The right solution is to use anon methods, and it would be very foolish to consider with the approach you have taken thus far. – David Heffernan Feb 26 '20 at 12:55
  • @David Thank you for reopening this question. I've already been looking into this and it looks like the rbx register is stored in rcx register just before the local procedure is called. (Note: in the 32-bit implementation the ebp was pushed on stack, just before the local procedure was called). So I've tried to call the local procedure in this way - but sadly, this did not work – Palka Feb 26 '20 at 13:10
  • You won't get me interested in working out pointless hacks. Maybe somebody else will be motivated to do so. Have fun! – David Heffernan Feb 26 '20 at 14:11
  • I rolled back your edit. If you want to add your solution, please do so as an answer to the question – David Heffernan Feb 27 '20 at 09:04
  • @David This is what I started with, but the popup 'Edit your question if you need to add more details.' changed my mind, as my edit was adding more details - see the question name: **How** to pass local procedure as a procedural parameter (callback). Based on this - I think you should roll back your roll back. – Palka Feb 27 '20 at 09:38

3 Answers3

1

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.

J...
  • 30,968
  • 6
  • 66
  • 143
  • Thank you for help. I agree this is nice and clean solution, however there are 1200+ places where I need to change the code, so I hope someone can help me to find a hack for the 64-bit version – Palka Feb 27 '20 at 00:00
  • 1
    You'll still have 1200 places to apply the hack as I read your code in the Q – David Heffernan Feb 27 '20 at 04:42
  • @Palka There might be the possibility to write a utility that scans your source files and patches them. I used that technique once. – Olivier Feb 27 '20 at 07:46
  • @David To be more exact there are 1200+ places where I would have to change a local procedure to the anonymouse one, but there are only about 11 peform procedures - so I have to patch 12 places in total compared to 1200+. However I will analyse if it's possible to write a utility which scans the code and converts the local procedures to anonymous ones, as this approach is definitely future proof compared to the hack – Palka Feb 27 '20 at 09:02
  • The code in the question has inline asm at the point where you call `Perform`. – David Heffernan Feb 27 '20 at 09:03
  • @David Yes, but this is such an example - simple enough to show to problem, not the real implementation. The real implementation is using a function call (instead of the inline asm), it's not using a global variable, passes parameters, adds type safety for different perform procedure, etc – Palka Feb 27 '20 at 09:31
  • @Palka Doing the same thing 1200 times should be easy for a developer. ;) I'm with David - if it was my codebase I'd just fix it. Take any opportunity to shed some technical debt. – J... Feb 27 '20 at 22:29
1

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.

LU RD
  • 34,438
  • 5
  • 88
  • 296
0

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

Palka
  • 19
  • 2