Browse Source

+ implementation of TObject.MethodName and TObject.MethodAddress (not
in the compiler yet)

florian 26 years ago
parent
commit
73b01893ce
1 changed files with 71 additions and 4 deletions
  1. 71 4
      rtl/inc/objpas.inc

+ 71 - 4
rtl/inc/objpas.inc

@@ -114,18 +114,59 @@
            ClassType:=TClass(Pointer(Self)^)
         end;
 
+      type
+         tmethodnamerec = packed record
+            name : pshortstring;
+            addr : pointer;
+         end;
+
+         tmethodnametable = packed record
+           count : dword;
+           entries : packed array[0..0] of tmethodnamerec;
+         end;
+
+         pmethodnametable =  ^tmethodnametable;
+
       class function TObject.MethodAddress(const name : shortstring) : pointer;
 
+        var
+           methodtable : pmethodnametable;
+           i : dword;
+
         begin
-           methodaddress:=nil;
+           methodtable:=pmethodnametable((Pointer(Self)+vmtMethodTable)^);
+           if assigned(methodtable) then
+             begin
+                for i:=1 to methodtable^.count do
+                  if methodtable^.entries[i].name^=name then
+                    begin
+                       MethodAddress:=methodtable^.entries[i].addr;
+                       exit;
+                    end;                  
+             end;
+           MethodAddress:=nil;
         end;
 
       class function TObject.MethodName(address : pointer) : shortstring;
 
+        var
+           methodtable : pmethodnametable;
+           i : dword;
+
         begin
-           methodname:='';
+           methodtable:=pmethodnametable((Pointer(Self)+vmtMethodTable)^);
+           if assigned(methodtable) then
+             begin
+                for i:=1 to methodtable^.count do
+                  if methodtable^.entries[i].addr=address then
+                    begin
+                       MethodName:=methodtable^.entries[i].name^;
+                       exit;
+                    end;                  
+             end;
+           MethodName:='';
         end;
-
+           
       function TObject.FieldAddress(const name : shortstring) : pointer;
 
         begin
@@ -185,6 +226,14 @@
            stringmessagetable:=pstringmessagetable((pointer(Self)+vmtMsgStrPtr)^);
         end;
 
+      type
+         tmessagehandler = procedure(var msg) of object;
+         tmessagehandlerrec = packed record
+            proc : pointer;
+            obj : pointer;
+         end;
+
+
       procedure TObject.Dispatch(var message);
 
         type
@@ -203,6 +252,7 @@
            msgtable : pmsgtable;
            p : pointer;
            vmt : tclass;
+           msghandler : tmessagehandler;
 
         begin
            index:=dword(message);
@@ -224,12 +274,18 @@
                      if index=msgtable[i].index then
                        begin
                           p:=msgtable[i].method;
+                          tmessagehandlerrec(msghandler).proc:=p;
+                          tmessagehandlerrec(msghandler).obj:=self;
+                          msghandler(message);
+                          { we don't need any longer the assembler
+                            solution                              
                           asm
                              pushl message
                              pushl %esi
                              movl p,%edi
                              call *%edi
                           end;
+                          }
                           exit;
                        end;
                   end;
@@ -249,6 +305,7 @@
            msgstrtable : pmsgstrtable;
            p : pointer;
            vmt : tclass;
+           msghandler : tmessagehandler;
 
         begin
            name:=pshortstring(@message)^;
@@ -269,12 +326,18 @@
                      if name=msgstrtable[i].name^ then
                        begin
                           p:=msgstrtable[i].method;
+                          tmessagehandlerrec(msghandler).proc:=p;
+                          tmessagehandlerrec(msghandler).obj:=self;
+                          msghandler(message);
+                          { we don't need any longer the assembler
+                            solution                              
                           asm
                              pushl message
                              pushl %esi
                              movl p,%edi
                              call *%edi
                           end;
+                          }
                           exit;
                        end;
                   end;
@@ -330,7 +393,11 @@
 
 {
   $Log$
-  Revision 1.8  1999-09-08 16:14:41  peter
+  Revision 1.9  1999-09-12 08:01:00  florian
+    + implementation of TObject.MethodName and TObject.MethodAddress (not
+      in the compiler yet)
+
+  Revision 1.8  1999/09/08 16:14:41  peter
     * pointer fixes
 
   Revision 1.7  1999/07/11 14:10:48  michael