paweld/pas2js
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/pas2js.git synced 2025-04-07 08:47:49 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Add ClassInfo and MethodAddress

Browse Source
This commit is contained in:
michael 2019-07-01 08:22:30 +00:00
parent 54d9b1573a
commit 5db4d0571c
1 changed files with 40 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
packages/rtl/system.pas
View File

@ -138,6 +138,9 @@ type
class property ClassParent: TClass read FClassParent;
class function InheritsFrom(aClass: TClass): boolean; assembler;
class property UnitName: String read FUnitName;
Class function MethodName(aCode : Pointer) : String;
Class function MethodAddress(aName : String) : Pointer;
Class Function ClassInfo : Pointer;
procedure AfterConstruction; virtual;
procedure BeforeDestruction; virtual;
@ -840,6 +843,43 @@ asm
return (aClass!=null) && ((this==aClass) || aClass.isPrototypeOf(this));
end;
Class function TObject.MethodName(aCode : Pointer) : String;
begin
end;
Class function TObject.MethodAddress(aName : String) : Pointer;
// We must do this in asm, because the typinfo unit is not available.
begin
asm
var i = 0;
var TI = this.$rtti;
var N = "";
var MN = "";
N = aName.toLowerCase();
while ((MN === "") && (TI != null)) {
i = 0;
while ((MN === "") && (i < TI.methods.length)) {
if (TI.getMethod(i).name.toLowerCase() === N) MN = TI.getMethod(i).name;
i += 1;
};
if (MN === "") TI = TI.ancestor;
};
if (MN !== "") Result = this[MN];
return Result;
end;
end;
Class Function TObject.ClassInfo : Pointer;
begin
// This works different from FPC/Delphi.
// We get the actual type info.
Result:=TypeInfo(Self);
end;
procedure TObject.AfterConstruction;
begin