Anonymous methods may have associated state. In particular, all variables that an anonymous method captures need to be kept alive so long as the anonymous method is callable. For this reason, anonymous methods are implemented with a lifetime management approach: anonymous methods are actually methods on an object which implements COM-style reference counted interfaces. Method references are interface references with a single method called Invoke.
If one badly wants to store an anonymous method in a method pointer, this information can be used to shoehorn it in. Here's how it can be done:
procedure MethRefToMethPtr(const MethRef; var MethPtr); type TVtable = array[0..3] of Pointer; PVtable = ^TVtable; PPVtable = ^PVtable; begin // 3 is offset of Invoke, after QI, AddRef, Release TMethod(MethPtr).Code := PPVtable(MethRef)^^[3]; TMethod(MethPtr).Data := Pointer(MethRef); end;
This procedure will take a method reference as the first argument, and then extract the two crucial pieces of data needed to put into a method pointer: the value to be passed as the first argument (the method, or interface, reference), and the code address to be called (the value of the Invoke entry in the interface's vtable).
The procedure can be used as follows. Note that the method reference still needs to be kept alive somewhere as long as the method pointer is callable to avoid premature disposal of the heap-allocated object:
type TMeth = procedure(x: Integer) of object; TMethRef = reference to procedure(x: Integer); function MakeMethRef: TMethRef; var y: Integer; begin y := 30; Result := procedure(x: Integer) begin Writeln('x = ', x, ' and y = ', y); end; end; procedure P; var x: TMethRef; m: TMeth; begin x := MakeMethRef(); MethRefToMethPtr(x, m); Writeln('Using x:'); x(10); Writeln('Using m:'); m(10); end;
On the other hand, if the anonymous method's body never captures any variables, then it's not necessary to keep the method reference around. This loses much of the benefits of anonymous methods, but it does prove the point:
uses SysUtils, Forms, StdCtrls, Dialogs, classes; procedure MethRefToMethPtr(const MethRef; var MethPtr); type TVtable = array[0..3] of Pointer; PVtable = ^TVtable; PPVtable = ^PVtable; begin // 3 is offset of Invoke, after QI, AddRef, Release TMethod(MethPtr).Code := PPVtable(MethRef)^^[3]; TMethod(MethPtr).Data := Pointer(MethRef); end; type TNotifyRef = reference to procedure(Sender: TObject); function MakeNotify(const ANotifyRef: TNotifyRef): TNotifyEvent; begin MethRefToMethPtr(ANotifyRef, Result); end; procedure P; var f: TForm; btn: TButton; begin f := TForm.Create(nil); try btn := TButton.Create(f); btn.Parent := f; btn.Caption := 'Click Me!'; btn.OnClick := MakeNotify(procedure(Sender: TObject) begin ShowMessage('Hello There!'); end); f.ShowModal; finally f.Free; end; end; begin try P; except on e: Exception do ShowMessage(e.Message); end; end.
2 comments:
Hi,Barry.
Good stuff.
A little optimization(in some cases the closure object may be dead, i.e. replace showmodal to show for scoping out the TemporaryClosureInfRef)
TMethod(MethPtr).Data := nil;
Have you read my message to you on gmail(sorry for my english)?
1. An other optimization for R&D just for such cases create fake interface in data section(i.e one instance with no copy semantic).
2. Allow Empty closure ( ) to be an subtype to regular proc or method with the same signature.
What do you think?
Post a Comment