[Back to MEMORY SWAG index] [Back to Main SWAG index] [Original]

    PROGRAM Tst_VMT;

    Type   TAObject = object
                       constructor Init;
                       procedure   MethodA; virtual;
                       procedure   MethodB; virtual;
                      end;
    Type   TBObject = object(TAObject)
                       procedure   MethodA; virtual;
                      end;

    Var    MethodAOffsetInVMT,
           MethodBOffsetInVMT  : integer;
           ItIsAObject         : TAObject;
           ItIsBObject         : TBObject;

    {--- TAObject -------------------------------------------------------}

    Constructor TAObject.Init;

    Begin
    End;

    {--------------------------------------------------------------------}

    Procedure TAObject.MethodA;

    Begin
        Writeln('It is method A !!!');
    End;

    {--------------------------------------------------------------------}

    Procedure TAObject.MethodB;

    Begin
        Writeln('It is method B !!!');
    End;

    {--- TAObject -------------------------------------------------------}

    Procedure TBObject.MethodA;

    Begin
        Writeln('It is method A (some changed) !!!');
    End;

    {--------------------------------------------------------------------}

    Function GetOffsetInVMT(VMTAddr : pointer; MethodAddr : pointer): integer;

    Type   TAddrRec       = record  Offs,Segm : word  end;

    Const  VMTHeaderSize  = 8;     { This is a size of VMT header     }
           MaxMethodsOffs = 100 * SizeOf(pointer) + VMTHeaderSize;
                           { Maximal offset of method in VMT (abstract) }

    Var    VMTOffs        : word;
           CurAddr        : ^pointer;

    Begin
        VMTOffs := VMTHeaderSize;
        While (VMTOffs < MaxMethodsOffs) and
              (pointer( Ptr(TAddrRec(VMTAddr).Segm,
                            TAddrRec(VMTAddr).Offs + VMTOffs)^
                      ) <> MethodAddr) do
         Inc(VMTOffs, SizeOf(pointer));
        If VMTOffs >= MaxMethodsOffs
         then  GetOffsetInVMT := 0   { Damn, there is no such method! }
         else  GetOffsetInVMT := VMTOffs;
    End;

    {--------------------------------------------------------------------}

    Begin
        ItIsAObject.Init;
        ItIsBObject.Init;
        ItIsAObject.MethodA;
        ItIsAObject.MethodB;
        MethodAOffsetInVMT := GetOffsetInVMT(TypeOf(TAObject),
                                             @TAObject.MethodA);
        MethodBOffsetInVMT := GetOffsetInVMT(TypeOf(TAObject),
                                             @TAObject.MethodB);
        Writeln(MethodAOffsetInVMT);
        Writeln(MethodBOffsetInVMT);

        { --- Let's call TBObject.MethodA  }
        asm
          mov  di,offset ItIsBObject
          push ds              { Pushing @Self for object in stack }
          push di
          mov  di,[di]         { VMT offset in data segment }
          add  di,[MethodAOffsetInVMT]  { Adding method offset in VMT }
          call dword ptr [di]
        end;
    End.

[Back to MEMORY SWAG index] [Back to Main SWAG index] [Original]