Felix E. Klee wrote:
Quote
But then you need to write an additional C interface because, as you
surely know, a gcc built QT is not ABI compatible with Kylix. When using
C++ you can use my Kylix QT Port
No I meant that I can import gcc 3.2 generated classes directly into Kylix
Delphi. No C wrapper shared object. The following code is just my first
"Delphi wapper". It is a start but not the end of simple wrapper.
class TBase {
public:
TBase();
virtual ~TBase();
};
class TDerived: public TBase {
private:
int value;
public:
virtual int getValue() const;
};
TBase::TBase() {}
TBase::~TBase() {}
int TDerived::getValue() const { return value; }
extern "C" {
TDerived* getDerived() { return new TDerived(); }
int getValue(TDerived* v) { return v->getValue(); }
void destroyBase(TBase* b) { delete b; }
}
------------------------------------------
gcc -shared test.cc -o test.so.1.0
------------------------------------------
------------------------------------------
unit SymbolImport_test_so;
interface
{ I've modified the file }
// Auto generated by SOSymbolImporter 0.1 do not edit.
const
TestLib = '/home/andy/kylix/gcc/t2/test.so.1.0';
const
TBase__TBase_1 = '_ZN5TBaseC1Ev'; // TBase::TBase()
TBase_x_TBase_1 = '_ZN5TBaseD1Ev'; // TBase::~TBase()
TBase_x_TBase_2 = '_ZN5TBaseD0Ev'; // TBase::~TBase()
TDerived__TDerived = '_ZN8TDerivedC1Ev'; // TDerived::TDerived()
TDerived__getValue = '_ZNK8TDerived8getValueEv'; // TDerived::getValue()
implementation
end;
------------------------------------------
program Test
{$APPTYPE CONSOLE}
uses Libc, SysUtils, SymbolImport_test_so;
type
TPointerArray = array[0..65535] of procedure(Self: Pointer); cdecl;
PVMT = ^TVMT;
TVMT = packed record Items: TPointerArray; end;
function GetVMT(Self: Pointer): PVMT; asm mov eax, [eax]; end;
procedure SetVMT(Self, VMT: Pointer); asm mov [eax], edx; end;
type
TDefaultConstructor = procedure of object; cdecl;
TBase = class
private
procedure _Create; cdecl; // gcc constructor
protected
procedure _DestroyD1; virtual; cdecl; // stack based delete
procedure _DestroyD0; virtual; cdecl; // heap based delete
constructor GccCreate(DefaultConstructor: TDefaultConstructor);
public
constructor Create;
destructor Destroy; override;
procedure Free;
end;
TDerived = class(TBase)
protected
value: Integer;
procedure _Create; cdecl;
public
function getValue: Integer; virtual; cdecl;
end;
// this is our derived class
TMyDerived = class(TDerived)
public
function getValue: Integer; override;
end;
procedure TBase._Create; external TestLib name TBase__TBase_1;
procedure TBase._DestroyD1; external TestLib name TBase_x_TBase_1;
procedure TBase._DestroyD0; external TestLib name TBase_x_TBase_2;
procedure TDerived._Create; external TestLib name TDerived__TDerived;
function TDerived.getValue; external TestLib name TDerived__getValue;
function getValue(v: TDerived): Integer; cdecl; external TestLib;
function getDerived: TDerived; cdecl; external TestLib;
function destroyBase(b: TBase): TDerived; cdecl; external TestLib;
constructor TBase.GccCreate(DefaultConstructor: TDefaultConstructor);
var MyVMT: PVMT;
begin
// gcc constructor sets its VMT so we restore our
MyVMT := GetVMT(Self);
try
DefaultConstructor;
finally
SetVMT(Self, MyVMT);
end;
end;
constructor TBase.Create;
begin
GccCreate(_Create);
end;
destructor TBase.Destroy;
var MyVMT: PVMT;
begin
// gcc destructor restores its VMT. So we restore our
MyVMT := GetVMT(Self);
try
_DestroyD1; // stack based destroy;
finally
SetVMT(Self, MyVMT);
end;
end;
procedure TBase.Free;
var Index: Integer;
begin
if Self <>nil then
begin
Index := -2; // Delphi: @FreeInstance | gcc: nil
if Assigned(GetVMT(Self)^.Items[Index]) then
Destroy
else
_DestroyD0; // heap based destroy;
end;
end;
procedure Test;
var v: TDerived;
begin
v := getDerived; // test.so creates a TDerived* instance
try
WriteLn(getValue(v)); // prints '0'
finally
v.Free; // Delphi's destructor
end;
v := TMyDerived.Create; // Delphi created instance
try
WriteLn(getValue(v)); // prints '100'
finally
destroyBase(v); // test.so destroys the instance.
end;
end;
function TMyDerived.getValue: Integer;
begin
Result := 100;
end;
begin
Test;
ReadLn;
end.
-------------------------------------------------------
--
Regards,
Andreas Hausladen
(
www.kylix-patch.de.vu unofficial VisualCLX patches)