Virtual Method Table & Delphi & Borland Pascal 7.0

← →
DarkGreen (2002-09-18 12:07) [0]

Доброе время суток уважаемые мастера!
Немного истории. :-)
В BP 7.0 можно было объявлять методы объектов следующим образом:
TMyApp = object(TApplication) MyVar: Integer; constructor Init; destructor Done; MyVirtualMethod(AVar: Integer); virtual cmMyCommand; end;

В чем, суть. Любому виртуальному методу можно было назначить некую команду, которая потом автоматически обрабатывалась в TView.HandleEvent (на сколько я понимаю только с Turbo Vision v.2.0) Команда, которая указывается после слова virtual судя по всему (сужу по исходным кодам TV) являлась индексом в VMT данного объекта. Далее в TView.HandleEvent был следующий код:
if (Options and ofAutoCommand <> 0) and (Event.What = evCommand) then if DoDynamic(TypeOf(Self), Event.Command) then ClearEvent(Event);
Мутоду DoDynamic передается указатель на VMT объекта, а также команда, которая была назначена методу (TypeOf(Self) возвращает указатель на VMT). Сам метода путем последовательного скана находил указатель на метод и вызывал его.
Скачал с http://delphi.mastak.ru/ Turbo Vision портированные под Делфи, поправил несколько ошибок, добавил то, что есть у меня в своих вижинах, ну и начал проверять. Выяснилось, что ни чего не работает именно из-за функции DoDynamic, как я понял, в Делфях изменилась структура VMT.
Вопрос:
1. Где найти описание структуры VMT (на system.pas не посывать, был и там и в хелпе, там есть только описание заголовка)
2. Делфи не протестует против подобного объявления:
MyVirtualMethod(AVar: Integer); virtual cmMyCommand;
Но что, оно для Делфей означает? В хепе информации нету :-(

← →
Старый Паскалист (2002-09-18 12:22) [1]

>MyVirtualMethod(AVar: Integer); virtual cmMyCommand;

Это была старая нотация динамических методов.
Cейчас это пишется так:

MyVirtualMethod(var AMsg: TMessage); message cmMyCommand;
(в принципе, параметр можно любой var, но тогда тебе самому
придётся делать диспетчеризацию, т.к. стандартная,
Dispatch, расчитана именно на var AMsg: TMessage).

← →
DarkGreen © (2002-09-18 13:28) [2]

2 Старый Паскалист.
Про новую-то нотацию знаю, вот только переписывать на нее все классы лень, да и времени нет, думал есть возможность перейти на Win32 Console App малой кровью. Но судя по всему не получится

← →
Старый Паскалист (2002-09-18 13:29) [3]

А вот структура VMT и сопутствующие таблицы:
(кстати, у меня Дельфи ругается на virtual cmMyCommand;)

unit RttiD5; interface uses Classes, TypInfo; type {---------vmtFieldTable--------------------------------------------------------} PClass = ^TClass; PFieldClassTable = ^TFieldClassTable; TFieldClassTable = packed record Count: Word; Classes: packed array[0..MaxListSize] of PClass; {Classes: packed array[0..Count-1] of PClass;} end; PVmtField = ^TVmtField; TVmtField = packed record Offset: Cardinal; {Смещение поля в данных класса} ClassIndex: Word; {Индекс в FieldClassTable} Name: ShortString; end; PVmtFieldTable = ^TVmtFieldTable; TVmtFieldTable= packed record Count: Word; FieldClassTable: PFieldClassTable; Fields: packed array[0..MaxListSize] of Byte; {Fields: packed array[0..Count-1] of TVmtField;} // TVmtField имеет переменную длину end; {----------vmtMethodTable------------------------------------------------------} PVmtMethod = ^TVmtMethod; TVmtMethod = packed record Size: Word; Address: Pointer; Name: ShortString; end; PVmtMethodTable = ^TVmtMethodTable; TVmtMethodTable = packed record Count: Word; Methods: array [0..MaxListSize] of Byte; { Methods : array [0..Count-1] of TVmtMethod; } // TVmtMethod имеет переменную длину end; {------------------------------------------------------------------------------} PParamData = ^TParamData; TParamData = record Flags: TParamFlags; ParamName: ShortString; //TypeName: ShortString; end; {-------------vmtDynamicTable--------------------------------------------------} PVmtDynMethodTable = ^TVmtDynMethodTable; TVmtDynMethodTable = packed record Count : Word; Data : packed array[0..MaxListSize] of Byte; {Indexes : packed array [1..Count] of SmallInt; Addresses : packed array[1..Count] of Pointer;} end; {------------vmtAutoTable------------------------------------------------------} const argVar = 128; // комбинируется с остальными argNoResult = 0; argSmallInt = 2; argLongInt = 3; // также LongWord argSingle = 4; argDouble = 5; argCurrency = 6; argDateTime = 7; argWideString = 8; argIDispatch = 9; argLongBool = 11; argVariant = 12; argIUnknown = 13; argByte = 17; argAnsiString = 72; atflagMethod = 1; atflagPropGet = 2; atflagPropSet = 4; atflagVirtual = 8; // комбинируется с остальными type PVmtAutoMethodArgList = ^TVmtAutoMethodArgList; TVmtAutoMethodArgList = packed record Result: Byte; ArgCount: Byte; Args: packed array[0..MaxListSize]of Byte; end; PVmtAutoMethod = ^TVmtAutoMethod; TVmtAutoMethod = packed record Dispid: Longint; PName: PShortString; Flags: LongWord; PArgList: PVmtAutoMethodArgList; Address: Pointer; // Method Address or offset in VMT for virtual - 0 4 8 ... end; PVmtAutoTable = ^TVmtAutoTable; TVmtAutoTable = packed record Count: Longint; Methods: packed array[0..MaxListSize div 16]of TVmtAutoMethod; end; {------------vmtInitTable------------------------------------------------------} // For every field in object, that needs be released // (strings, dynamic arrays, interface references etc) PVmtReleaseField = ^TVmtReleaseField; TVmtReleaseField = packed record FieldType: PPTypeInfo; // for string: PPTypeInfo^ = PPTypeInfo + 4 Offset: Longint; end; PVmtInitTable = ^TVmtInitTable; TVmtInitTable = packed record E00000: packed array [0..5]of Byte; // six bytes of unknown purpose = $E $0 $0 $0 $0 $0 Count: Longint; Fields: packed array[0..MaxListSize]of TVmtReleaseField; {0..Count-1} end; {------------vmtIntfTable------------------------------------------------------} PPropData = ^TPropData;

← →
Старый Паскалист (2002-09-18 13:29) [4]

(*
{ TypInfo.pas }

TTypeKind = (tkUnknown, tkInteger, tkChar, tkEnumeration, tkFloat,
tkString, tkSet, tkClass, tkMethod, tkWChar, tkLString, tkWString,
tkVariant, tkArray, tkRecord, tkInterface, tkInt64, tkDynArray);
TTypeKinds = set of TTypeKind;

TOrdType = (otSByte, otUByte, otSWord, otUWord, otSLong);

TFloatType = (ftSingle, ftDouble, ftExtended, ftComp, ftCurr);

TMethodKind = (mkProcedure, mkFunction, mkConstructor, mkDestructor,
mkClassProcedure, mkClassFunction,
{ Obsolete }
mkSafeProcedure, mkSafeFunction);

TParamFlag = (pfVar, pfConst, pfArray, pfAddress, pfReference, pfOut);
TParamFlags = set of TParamFlag;
TParamFlagsBase = set of TParamFlag;
TIntfFlag = (ifHasGuid, ifDispInterface, ifDispatch);
TIntfFlags = set of TIntfFlag;
TIntfFlagsBase = set of TIntfFlag;

ShortStringBase = string[255];

PPTypeInfo = ^PTypeInfo;
PTypeInfo = ^TTypeInfo;
TTypeInfo = record
Kind: TTypeKind;
Name: ShortString;
{TypeData: TTypeData}
end;

PTypeData = ^TTypeData;
TTypeData = packed record
case TTypeKind of
tkUnknown, tkLString, tkWString, tkVariant: ();
tkInteger, tkChar, tkEnumeration, tkSet, tkWChar: (
OrdType: TOrdType;
case TTypeKind of
tkInteger, tkChar, tkEnumeration, tkWChar: (
MinValue: Longint;
MaxValue: Longint;
case TTypeKind of
tkInteger, tkChar, tkWChar: ();
tkEnumeration: (
BaseType: PPTypeInfo;
NameList: ShortStringBase));
tkSet: (
CompType: PPTypeInfo));
tkFloat: (
FloatType: TFloatType);
tkString: (
MaxLength: Byte);
tkClass: (
ClassType: TClass;
ParentInfo: PPTypeInfo;
PropCount: SmallInt;
UnitName: ShortStringBase;
{PropData: TPropData});
tkMethod: (
MethodKind: TMethodKind;
ParamCount: Byte;
ParamList: array[0..1023] of Char
{ParamList: array[1..ParamCount] of
record
Flags: TParamFlags;
ParamName: ShortString;
TypeName: ShortString;
end;
ResultType: ShortString});
tkInterface: (
IntfParent : PPTypeInfo; { ancestor }
IntfFlags : TIntfFlagsBase;
Guid : TGUID;
IntfUnit : ShortStringBase;
{PropData: TPropData});
tkInt64: (
MinInt64Value, MaxInt64Value: Int64);
end;

TPropData = packed record
PropCount: Word;
PropList: record end;
{PropList: array[1..PropCount] of TPropInfo}
end;

PPropInfo = ^TPropInfo;
TPropInfo = packed record
PropType: PPTypeInfo;
GetProc: Pointer;
SetProc: Pointer;
StoredProc: Pointer;
Index: Integer;
Default: Longint;
NameIndex: SmallInt;
Name: ShortString;
end;

TPropInfoProc = procedure(PropInfo: PPropInfo) of object;

PPropList = ^TPropList;
TPropList = array[0..16379] of PPropInfo;

const
tkAny = [Low(TTypeKind)..High(TTypeKind)];
tkMethods = [tkMethod];
tkProperties = tkAny - tkMethods - [tkUnknown];

*)

{------------vmtIntfTable------------------------------------------------------}

(*
{ System.pas }

PInterfaceEntry = ^TInterfaceEntry;
TInterfaceEntry = packed record
IID: TGUID;
VTable: Pointer;
IOffset: Integer;
ImplGetter: Integer;
end;

PInterfaceTable = ^TInterfaceTable;
TInterfaceTable = packed record
EntryCount: Integer;
Entries: array[0..9999] of TInterfaceEntry;
end;
*)

implementation

end.

← →
REA (2002-09-18 13:38) [5]

Лезть руками в VMT дело неблагодарное. Вдруг оно поменяется.
И че то они дофига раздули RTTI - программы пухнут только из-за него, а отключить RTTI стандартных классов никак.

← →
DarkGreen © (2002-09-18 13:54) [6]

2 Старый Паскалист:
Сенкс, премного благодарен.
Ругается неверное потому, что ты объявил:
MyObj = class(Some Class) procedure MyMethod; virtual cmMyCommand;
а у меня
MyObj = object(Some Class) procedure MyMethod; virtual cmMyCommand;
2 REA: Лезть придется, если неохота все исходники заново переписывать, когда переходишь с TV BP7.0 на TV портированные под Delphi

← →
Старый Паскалист (2002-09-18 14:35) [7]

Кстати, всё вышеизложенное относилось именно к модели "class".
Как устроена VMT у "object", я не знаю.

Таблица динамических методов, я думаю, у него устроена так же.
Но где находится указатель на неё - не знаю, но это можно выяснить с
помощью отладчика.
По идее у "object" не должно быть других таблиц RTTI, кроме DMT и, возможно, аналога InitTable
(для корректного освобождения строк, дин. массивов ит.п.).

Возможно, что сделать аналог DoDynamic окажется не так уж сложно.

← →
DarkGreen © (2002-09-18 16:08) [8]

Хм... А откуда у объекта с виртуальными методами таблица динамических методов? Она же существует только для методов объявленных dynamic, или я чего-то не понимаю?

← →
Старый Паскалист (2002-09-18 16:27) [9]

Как устроена ВМТ у "class"a:

Первый байт каждого объекта указывает на VMT, т.е. на
первый виртуальный (не динамический) метод. По отрицательному
смещению от этого адреса расположен указатель на таблицу динамических
методов (DMT), в которой по двубайтовому знаковому селектору можно найти
адрес динамического метода. (Если не найден - надо идти к ВМТ предка -
указатель на него расположен также по отрицательному смещению от ВМТ)

В общем, вызов обычного виртуального метода осуществляется
через фиксированную точку входа в ВМТ, а вызов динамического -
с помощью поиска метода по идентификатору (селектору) в некоторой таблице.

Я думаю, примерно также (в принципе) устроен и "object".
Т.е. от ВМТ можно как-то перейти к ДМТ и ВМТ предка.

Я сейчас бегло посмотрел в отладчик - видно, что ВМТ у "object"a расположена
не вначале, а в конце (для базового класса, естественно). Поля потомков идут
уже после.
В общем, с помощью отладчика можно легко выяснить, как всё устроено.

← →
Старый Паскалист (2002-09-18 17:08) [10]

Судя по всему, в "object"ах нет динамических методов,
и, соответственно, DMT.
Компилятор не ругается на число после virtual, но игнорирует его.

Облом-с.

Стойте, горячие финские парни.
Для начала немного ясности с тем как описываются методы в TP и Delphi.

TP:
virtual; - виртуальный метод
virtual XXX; - динамический метод с идентификатором

В Delphi были введены динамические методы без идентификатора и более четко разделены сами динамические и виртуальные методы:

virtual; - виртуальный метод
message XXX; - динамический метод с идентификатором
dynamic; - динамический метод без идентификатора

Далее. DMT у Object есть, это точно. Вызов метода через DMT использовался в OWL (но не в TV). Как именно это делалось - уже не помню сейчас. Для того, чтобы с этим разобраться нужно где-то найти исходники OWL(Object Windows Library) от TP и посмотреть там.

← →
Старый Паскалист (2002-09-18 17:50) [12]

vuk © (18.09.02 17:43)
В трубопаскале DMT, естественно, была.
И я тоже думал, что она осталась.

Но в отладчике видно, что вызов простой виртуальной ф-и
ничем не отличается от вызова virtual XXX.
Видимо, в Дельфёвой интерпретации DMT оказалась унасекомлена.
(для "object"ов), поэтому исходники OWL ничем тут не помогут.
:(

Стоим :-)
DMT у object нет. Вот простой пример:
type PMyObj1 = ^TMyObj1; TMyObj1 = object Str: string; constructor Init(AStr: string); destructor Done; procedure MyMethod; dynamic; abstract; procedure MyMethod1(var Msg: TMessage); message WM_USER+100; end;
Компилятор заругается на dynamic и message
OWL конечно я найти могу, но толку, не с OWL"а перехожу, а с TV на TV под Делфи :-(
Ни какого поиска в VMT при использовании объектов (не классов) не просходит. При вызове любого виртуального метода Делфи генерит приблизительно следующий код:
mov eax, [eax] //Указатель на VMT грузит? mov edx, [eax+$04] //Смещение метода от начала VMT (по нулевому смещению коструктор сидит) call dword ptr [edx] //Вот и вызов метода ни каких поисков

Virtual Method Table & Delphi & Borland Pascal 7.0 Найти похожие ветки