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

* Add MethodName, FieldAddress

Browse Source
This commit is contained in:
michael 2019-07-07 18:35:46 +00:00
parent cb834b582f
commit 3a623b5dc3
1 changed files with 49 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
packages/rtl/system.pas
View File

@ -140,6 +140,7 @@ type
class property UnitName: String read FUnitName;
Class function MethodName(aCode : Pointer) : String;
Class function MethodAddress(aName : String) : Pointer;
Class Function FieldAddress(aName : String) : Pointer;
Class Function ClassInfo : Pointer;
procedure AfterConstruction; virtual;
@ -847,12 +848,35 @@ end;
Class function TObject.MethodName(aCode : Pointer) : String;
begin
Result:='';
if aCode=Nil then
exit;
asm
var i = 0;
var TI = this.$rtti;
// Callback ?
if ((typeof aCode["fn"] === "string") && (typeof aCode["scope"] === "object")) return aCode["fn"];
// Not a callback, check rtti
while ((Result === "") && (TI != null)) {
i = 0;
while ((Result === "") && (i < TI.methods.length)) {
if (this[TI.getMethod(i).name] === aCode)
Result=TI.getMethod(i).name;
i += 1;
};
if (Result === "") TI = TI.ancestor;
};
return Result;
end;
end;
Class function TObject.MethodAddress(aName : String) : Pointer;
// We must do this in asm, because the typinfo unit is not available.
begin
Result:=Nil;
if AName='' then
exit;
asm
var i = 0;
var TI = this.$rtti;
@ -872,6 +896,31 @@ asm
end;
end;
class function TObject.FieldAddress(aName: String): Pointer;
begin
Result:=Nil;
asm
var aClass = null;
var i = 0;
var ClassTI = null;
var myName = aName.toLowerCase();
var MemberTI = null;
aClass = this.$class;
while (aClass !== null) {
ClassTI = aClass.$rtti;
for (var $l1 = 0, $end2 = ClassTI.fields.length - 1; $l1 <= $end2; $l1++) {
i = $l1;
MemberTI = ClassTI.getField(i);
if (MemberTI.name.toLowerCase() === myName) {
return MemberTI;
};
};
aClass = aClass.$ancestor ? aClass.$ancestor : null;
};
end;
end;
Class Function TObject.ClassInfo : Pointer;
begin