From 3a623b5dc321afb0ec9c11ddeca58bdf0b91b67c Mon Sep 17 00:00:00 2001 From: michael Date: Sun, 7 Jul 2019 18:35:46 +0000 Subject: [PATCH] * Add MethodName, FieldAddress --- packages/rtl/system.pas | 49 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 49 insertions(+) diff --git a/packages/rtl/system.pas b/packages/rtl/system.pas index ef135ad..62edde7 100644 --- a/packages/rtl/system.pas +++ b/packages/rtl/system.pas @@ -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