Can I use interfaces without invoking hidden try-finally's - delphi

I want to refactor DelphiAST to use interfaces to deal with different types, rather than the clunky
TDirectionary it uses now.
Some research shows that 70%+ of the running time is spend in the dictionary.
So I'll make interfaces like:
TSyntaxNode = class
...
end;
IIdentifier = interface
['{D72E945D-E397-4E02-B702-8AE6C235F9C6}']
function GetIdentifier: string;
property Identifier: string read GetIdentifier;
end;
IMethod = interface(Identifier)
['{8E6119DC-E0F3-42BD-A5BF-FB658E34499E}']
.....
end;
TMethodNode = class(TSyntaxNode, IMethod, IIdentifier,...)
...
end;
The problem according to Roman is:
Reference counting may cause performance issues. DelphiAST creates thousands of classes to produce the syntax tree (more than 100,000 of TSyntaxNode instances, when input file is big enough). How many times the reference counter would be called?
Every time that happens a hidden try finally is invoked and that will slow things way down.
Strict use of const in method params prevents the refcount code calling the method, but afaik it still happens every time you do something like, say, MyRef = List[0] - it will increment the refcount assigning to MyRef, even though the item is still present in the list.
How can I work with interfaces whilst not having to worry about refcounting and try-finally blocks?
I'm perfectly happy to manage destruction of classes manually.
Further info
I'm guessing I need to use TAggregatedObject as a base ancestor.
And I read somewhere that not assigning a GUID inhibits reference counting, but have to source to back that up.
However losing the GUID's would lead to problems in obtaining sub-interfaces so I'd have to devise a solution to that....

Can I use interfaces without invoking hidden try-finally's?
No. The compiler emits reference counting code with interfaces no matter what. You cannot avoid it.
You can implement you own version of interfaces using a record of function pointers. It will be more clunky but will avoid heap allocation and reference counting.

"Thousands of objects" always gives me a shiver. There is a significant overhead to an object in memory. You forget about it, but it pops up again when you're trying to manage thousands, or notice you loose performance on it, or start to try writing or reading from file...
Using interfaces won't change much as far as I can tell, since you still use objects (class instances) underneath.
Endeavours of this magnitude require specific use of good-old straight-to-memory data-structures. For example I've been playing with an AST stored in an array of records: https://github.com/stijnsanders/strato

Yes No you cancannot use interfaces without invoking try-finally's and refcounting.
You can however greatly reduce the number of hidden exception handlers.
You just have to be really careful to do two things.
Always use const parameters when passing interfaces.
Never store the interface in an interface type variable, but use a homebrew record to encapsulate the interface so that its refcount will not be touched.
Here's a sample of the encapsulating record:
type
TInterface<Intf: IInterface> = record
private
P: Pointer;
public
function I: Intf; inline;
class operator Implicit(const A: Intf): TInterface<Intf>; inline;
end;
function TInterface<Intf>.I: Intf;
begin
pointer(IInterface(Result)):= P;
end;
class operator TInterface<Intf>.Implicit(const A: Intf): TInterface<Intf>;
begin
Result.P:= pointer(IInterface(A));
end;
Here's a sample program to demonstrate the concept.
program Project32;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils;
type
TInterface<Intf: IInterface> = record
private
P: Pointer;
public
function I: Intf; inline;
class operator Implicit(const A: Intf): TInterface<Intf>; inline;
end;
ITest1 = interface
function Test1: integer;
end;
ITest2 = interface
function Test2: integer;
end;
TTest = class(TAggregatedObject, ITest1, ITest2)
function Test1: integer;
function Test2: integer;
end;
{ TTest }
function TTest.Test1: integer;
begin
Result:= 1;
end;
function TTest.Test2: integer;
begin
Result:= 2;
end;
{ TInterface<Intf> }
function TInterface<Intf>.I: Intf;
begin
pointer(IInterface(Result)):= P;
end;
class operator TInterface<Intf>.Implicit(const A: Intf): TInterface<Intf>;
begin
Result.P:= pointer(IInterface(A));
end;
var
I1: TInterface<ITest1>;
I2: TInterface<ITest2>;
Test: TTest;
begin
Test:= TTest.Create(nil); //Force AV on _AddRef, _Release
If (Test.Test1 = 1) then WriteLn(S);
I1:= Test;
If (I1.I.Test1 =1) then WriteLn(S);
I2:= Test;
If (I2.I.Test2 = 2) then WriteLn(S);
ReadLn(s);
Test.Free;
end.
The TAggregatedObject does not have a interface to handle the _AddRef/_Release calls.
During the lifetime of the program, no problems will occur, however Delphi does wrap the creation of TTest in a try-finally which will generate an exception when exiting the function.
In real-world use you'd have to use a TInterfacedObject. If you pass the interface references around a lot it might help though.

Related

Delphi closure and "old style" object type

Working with anonymous functions I found out that sometimes the compiler throws the following error:
E2555 Cannot capture symbol 'Self' when I try to use some field of the object.
I also noticed that this error seems to be related to the fact that a type, the method belongs to, is declared with "object" key word:
MyType = object()
field: integer;
...
end;
MyType.Method1()
begin
p := procedure
begin
// do something with field
end;
end;
However when a type is declared with "class" keyword it seems it works fine.
I know that to prevent the compiler error I can make a local copy of needed fields and use them inside the anonymous functions, but just to be sure - is "object" type cause of the compiler error and what's the reason of that?
Thanks in advance
As David properly analyzed it is because Self in your case is a value and not a reference. It cannot be moved to the internally created class - same is the case with any method arguments that are records. They also cannot be captured for the very same reason.
For arguments I usually copy them to a local variable which is being captured.
The same can be done for capturing Self in a record or object.
However if you capture it as value you get a copy and calling the closure later might have the "wrong" state because it captured a copy. To make it work similar you would have to capture a reference to Self but then for a value type you cannot guarantee that this reference is still valid when you call the closure.
You can see this in the following code:
program Project1;
{$APPTYPE CONSOLE}
uses
SysUtils;
type
TProc = reference to procedure;
PRecord = ^TRecord;
TRecord = object
y: Integer;
procedure Foo;
function GetProc: TProc;
end;
procedure TRecord.Foo;
begin
Writeln(y);
end;
function TRecord.GetProc: TProc;
var
this: PRecord;
begin
this := #Self;
Result :=
procedure
begin
this.Foo;
end;
end;
procedure Nested(var p: TProc);
var
r: TRecord;
begin
p := r.GetProc();
r.y := 0;
p();
r.y := 32;
p();
end;
procedure Main;
var
p: TProc;
begin
Nested(p);
p(); // <- wrong value because PRecord not valid anymore
end;
begin
Main;
end.
If you would capture TRecord it would do a local copy that it captures - you can see that it then will print 0 all the time.
Since Turbo Pascal object is long deprecated, it is reasonable for new language features not to have support for object.
There's not really any need to look much further. Since you are maintaining legacy code, I would not expect you to be introducing new language features like anonymous methods. Once you start introducing such language features, this no longer feels like legacy code maintenance and it would be reasonable to re-factor the code away from the legacy language features like object.
Having said that, I do note that the same restriction to capture applies in methods of advanced records.
type
TProc = reference to procedure;
TRecord = record
procedure Foo;
end;
procedure TRecord.Foo;
var
P: TProc;
begin
P :=
procedure
begin
Foo;
end;
end;
This fails to compile with error:
E2555 Cannot capture symbol 'Self'
Why does this code fail, even though advanced records are a fully supported modern feature?
I don't have an explanation for that and the documentation does not make it clear. A plausible explanation is that records are value types. When a local variable is captured, it is hoisted from being a stack allocated variable to a variable owned by an internally created class. That's possible for Self when Self is a reference to an instance of a class. But when Self is a value like a record, it is too late to hoist the record.
Or perhaps it is much more prosaic. Maybe the designers just implemented the most important use case (capturing Self for a class) and omitted the less widely used cases for expediency. It is frustrating that the documentation does not appear to give any rules for what can and cannot be captured.

How do I assign a pre-existing function to a TComparison<T>?

program Project55;
{$APPTYPE CONSOLE}
uses
System.Generics.Defaults;
type
TestRec<T> = record
Compare: TComparison<T>;
CompareI: IComparer<T>;
end;
var
TRI: TestRec<Integer>;
begin
TRI.CompareI:= TComparer<Integer>.Default;
TRI.Compare:= TRI.CompareI.Compare; //E2035 Not enough actual parameters
TRI.Compare:= #TRI.CompareI.Compare; //E2035 Not enough actual parameters
end.
I know I can assign the function body as an anonymous function, but why can't I assign an existing function?
Of course the following works, but that's just silly:
TRI.Compare:= function(const L,R: integer): Integer
begin
Result:= TRI.CompareI.Compare(L,R);
end;
PS. I'm using Delphi XE7, but I doubt the version matters.
Knowing that IComparer<T> is an interface with just one method that has the same signature as TComparison<T> and that anonymous methods are just interfaces with one method you can do the following.
IComparer<Integer>(TRI.Compare) := TRI.CompareI;
I am using that trick in Spring4D to avoid creating a wrapper object around a TComparison<T> to be passed as IComparer<T> because they are binary compatible.
Your attempts to perform this assignment fail because an interface method cannot be with assigned to a method reference variable. The language simply does not permit that. The types are not assignment compatible. Valid assignment sources are anonymous methods, methods of classes (instance or class) and unit scope procedures.
The tricks that can be seen in other answers all depend on in depth knowledge of the implementation details. Which means that they are subject to change. But in terms of the language, what you are attempting is not permitted.
Anonymous methods are not exactly method pointers. They are implemented as an interface with a single method "Invoke".
It is possible to extract a method pointer from an anonymous method, but as far as I know it relies on the current implementation details of anonymous method and could be subject to changes in future version of delphi. In other words, I would advise against it. This was taken verbatim from Barry Kelly's post here. (Which covers the topic more thoroughly than I do here)
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;
Based on your example, I'd propose this as an alternative
type
TestRec<T> = record
CompareI: IComparer<T>;
function Compare(const L, R : T) : Integer;
end;
[...]
function TestRec<T>.Compare(const L, R : T) : Integer;
begin
Result := CompareI.Compare(L,R);
end;
But then, it may/may not apply to your current situation.

Can I use generics to do the same operation on similar types of controls?

I am using Delphi 2010 and I have a unit where over the years I have added my own procedures and functions that can be used with any project I make, such as:
function ListBoxIsSelected(ListBox: TListBox): Boolean;
begin
Result:= ListBox.ItemIndex <> -1;
end;
The above uses TListBox as a parameter, so whenever the above function is used I must supply a listbox that is of TListBox class.
Now suppose I have some other component libraries that could work with the same function, For example the Jedi component classes.
How could I use the above function, when the Jedi listbox is TJvListBox class and my function is looking for TListBox class? Although both components are practically the same, the class names are different. If I provided the same function specifically for the TJvListBox it would likely work because they are both "listboxes":
function ListBoxIsSelected(ListBox: TJvListBox): Boolean;
begin
Result:= ListBox.ItemIndex <> -1;
end;
Now, I have whole load of procedures and functions written in the same kind of way where I need to pass a component as a parameter. Having to rewrite them again just to work with a different component class is not feasible!
How can I write this with generics?
You can't write that with generics, unless your target classes all descend from the same base class of course. (But then you wouldn't need generics for it.)
If you really want something that can check if the ItemIndex property on any object <> -1, though, you can do that with a different Delphi 2010 feature: extended RTTI.
uses
SysUtils, RTTI;
function IsSelected(item: TObject): boolean;
var
context: TRttiContext;
cls: TRttiType;
prop: TRttiProperty;
ItemIndex: integer;
begin
if item = nil then
raise Exception.Create('Item = nil');
context := TRttiContext.Create;
cls := context.GetType(item.ClassType);
prop := cls.GetProperty('ItemIndex');
if prop = nil then
raise Exception.Create('Item does not contain an ItemIndex property.');
ItemIndex := prop.GetValue(item).AsInteger;
result := ItemIndex <> -1;
end;
Careful, though. There's no compile-time type checking here, and this process is significantly slower than your original routine. You probably won't notice it, but if you call something like this in a tight loop, it will slow it down.
I don't understand how I can write this with Generics?
You can’t – not unless your component implements a common interface or inherits from a common base class with the standard ListBox, and that interface / base class offers the ItemIndex property.
In fact, this use-case isn’t such a great example of generics because using an interface or base class in the declaration would work just as well.
In this case, you can write two overloaded functions, one expecting TJvListBox and the other expecting TListBox.
In more complex cases this approach may not apply so well, but I think your case is simple enough for this solution.
I cannot look it up right now (on holiday, no Delphi), but don't TJvListBox and TListBox descend from a common ancestor (my guess would be: TCustomListBox)? In that case something like this should work:
interface
function TListBox_IsItemSelected(_ListBox: TCustomListBox): boolean;
implementation
function TListBox_IsItemSelected(_ListBox: TCustomListBox): boolean;
begin
Result := _ListBox.ItemIndex <> -1;
end;
Just in case ItemIndex (as I said: I cannot check right now) is protected in TCustomListBox, you can just use a typecast hack:
type
TListBoxHack = class(TCustomListBox)
end;
function TListBox_IsItemSelected(_ListBox: TCustomListBox): boolean;
begin
Result := TListBoxHack(_ListBox).ItemIndex <> -1;
end;
(I just thought I should mention this since the original question has already been answered: Using Generics does not help here.)

generic locked pool, adding generic to non generic tlist

I tried my hand at a generic class, and on a second attempt I've tried to make a generic locked pool. I almost got it to work
I stumble on the spot where I want to put a generic typed class into a locked tlist obtained from tthreadlist.
The main question is:
Does anybody know a solution to this problem? (see "problem spot" in the source)
Hints, minor questions:
Do I need an additional constraint that signals reference? (I tried adding ,reference to the already existing class and constructor)
Does sb know a good overview page of all "special" generic constraints (class,constructor) . Couldn't find much in the manual.
the company is at D2009, but I've a single license DXE for migration preparation purposes.
The objects used by this pool are tobject, and worse, some of them have some crucial methods that must be inlined. (it is an image processing app, which is also why I'm not that concerned with relative simply locks. Granularity is coarse). I mention this, since it might make interface based solutions difficult.
type
TLockedPool<T:class,constructor> = class
private
lst : tthreadlist;
public
type sometype =t; // part of workarounds.
destructor destroy;
constructor create;
function getitem:T;
procedure putitem(var b:T);
end;
constructor TLockedPool<T>.create;
begin
lst:=TThreadlist.Create;
end;
destructor TLockedPool<T>.destroy;
var i : integer;
v: tlist;
begin
v:=lst.locklist;
for i:=0 to v.count-1 do
Tobject(v[i]).Free;
lst.unlocklist;
v.clear;
freeandnil(lst);
inherited;
end;
function TLockedPool<T>.getitem: T;
var cnt:integer;
v : tlist;
begin
v:=lst.LockList;
cnt:=v.Count;
if cnt>0 then
begin
result:=tobject(v[cnt-1]);
v.delete(cnt-1);
end
else
begin
result:=T.create;
end;
lst.UnlockList;
end;
procedure TLockedPool<T>.putitem(var b: T);
var v : Tlist;
x : sometype;
begin
if assigned(b) then // some older parts of the framework are dirty and try to put in NILs.
begin
v:=lst.LockList;
x:=b;
v.Add(pointer(sometype(x))); // <--- the problemspot
lst.unlocklist;
end;
b:=nil;
end;
Use v.Add(TObject(x)) or, if you must (it may not work in 2009, awkward for me to check), v.Add(PPointer(#x)^).

Bypassing (disabling) Delphi's reference counting for interfaces

For one particular issue in the architecture of an application I'm working on, interfaces seem to be a nice solution. Specifically, some "business objects" depend on a bunch of settings that are pulled from the database in the actual app. Letting those business objects ask for an interface (through Inversion of Control), and letting a central TDatabaseSettings object implement those interfaces, allows for better isolation, and thus for much easier unit testing.
However, in Delphi, interfaces seem to come with an, in this case, unpleasant bonus: reference counting. This means that if I do something like this:
type
IMySettings = interface
function getMySetting: String;
end;
TDatabaseSettings = class(..., IMySettings)
//...
end;
TMyBusinessObject = class(TInterfacedObject, IMySettings)
property Settings: IMySettings read FSettings write FSettings;
end;
var
DatabaseSettings: TDatabaseSettings;
// global object (normally placed in a controller somewhere)
//Now, in some function...
O := TMyBusinessObject.Create;
O.Settings := DatabaseSettings;
// ... do something with O
O.Free;
On the last line (O.Free), my global DatabaseSettings object is now also freed, since the last interface reference to it (which was contained in O) is lost!
One solution would be to store the 'global' DatabaseSettings object with an interface; another solution would be to override the reference counting mechanism for the TDatabaseSettings class, so I can continue to manage the DatabaseSettings as a normal object (which is much more consistent with the rest of the app).
So, in summary, my question is: how do I disable the interface reference counting mechanism for a particular class?
I've been able to find some info that suggests overriding the IInterface methods _AddRef and _Release for the class (TDatabaseSettings in the example); has anyone ever done that?
Or would you say I shouldn't do this (confusing? just a bad idea?), and find a different solution to the architectural problem?
Thanks a lot!
Ok, you can bypass it, but the question is if you really want that.
If you want to use interfaces, you better use them completely. So as you have experienced it, you get problems if you mix class and interface variables.
var
// DatabaseSettings: TDatabaseSettings;
DatabaseSettings : IMySettings;
//Now, in some function...
O := TMyBusinessObject.Create;
O.Settings := DatabaseSettings;
// ... do something with O
O.Free;
You now have a second reference to the interface and losing the first will not free the object.
It as also possible to keep both the class and the object:
var
DatabaseSettings: TDatabaseSettings;
DatabaseSettingsInt : IMySettings;
Be sure to set the interface right after the object has been created.
If you really want to disable reference counting, you just have to create a new descendant of TObject that implements IInterface. I have tested the example below in D2009 and it works:
// Query Interface can stay the same because it does not depend on reference counting.
function TMyInterfacedObject.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
if GetInterface(IID, Obj) then
Result := 0
else
Result := E_NOINTERFACE;
end;
constructor TMyInterfacedObject.Create;
begin
FRefCount := 1;
end;
procedure TMyInterfacedObject.FreeRef;
begin
if Self = nil then
Exit;
if InterlockedDecrement(FRefCount) = 0 then
Destroy;
end;
function TMyInterfacedObject._AddRef: Integer;
begin
Result := InterlockedIncrement(FRefCount);
end;
function TMyInterfacedObject._Release: Integer;
begin
Result := InterlockedDecrement(FRefCount);
if Result = 0 then
Destroy;
end;
FreeRef just lowers the refcount just like _Release. You can use it where you normally use Free.
Don't descend from TInterfacedObject, instead descend from TSingletonImplementation from standard System.Generics.Defaults unit.
TSingletonImplementation is a base for simple classes that need a basic IInterface implementation, with reference counting disabled.
TSingletonImplementation is a thread-safe base class for Delphi classes that support interfaces. Unlike TInterfacedObject, TSingletonImplementation does not implement reference counting.
_AddRef, _Release and _QueryInterface are, in fact, what you want to override. You should be very clear about what you're doing, however, as this can cause memory leaks or strange, hard-to-find bugs.
Don't descend from TInterfacedObject, instead descend from TObject, and implement your own versions of the first two of those methods that return 1.
To disable reference counting, AddRef and Release should do nothing but return -1
function TMyInterfacedObject._AddRef: Integer;
begin
Result := -1;
end;
function TMyInterfacedObject._Release: Integer;
begin
Result := -1;
end;
There is quite a lot of utility in interfaces without reference counting. If you use reference counting, then you cannot mix object and interface references as bad things will happen. By disabling ref counts, you can happily mix interface and object references without worrying about your objects suddenly getting auto destroyed.
Disabling reference counting for this kind of problem smells bad.
A much nicer and architectural solution would be to use some kind of "singleton" pattern.
The easiest way to implement this would look like:
interface
type
TDatabaseSettings = class(..., IMySettings)
end;
function DatabaseSettings: IMySettings;
implementation
var
GDatabaseSettings: IMySettings;
function DatabaseSettings: IMySettings;
begin
if GDatabaseSettings = nil then GDatabaseSettings := TDatabaseSettings.Create;
Result := GDatabaseSettings;
end;
O := TMyBusinessObject.Create;
O.Settings := DatabaseSettings;
O.Free;
By the way: when you use interfaces: always use interface variables! Do not mix both class en interface vars (use "var Settings: IMySettings" instead of "var Settings: TDatabaseSettings"). Otherwise reference counting will get in your way (auto destroy, invalid pointer operations, etc).
In the above solution, GDatabaseSettings is also of type "IMySettings", so it gets a proper reference count, and will last till your program terminates.
Or just use the code below:
var
I: IMyInterface;
begin
I := ...;
...
Do whatever you want in a scope;
Initialize(I); //- this will clear the interface variable without calling the _release.
end.

Resources