Форум: "Основная";
Текущий архив: 2002.09.30;
Скачать: [xml.tar.bz2];

Вниз

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, но игнорирует его.

Облом-с.

---

← →
vuk   (2002-09-18 17:43) [11]

Стойте, горячие финские парни.
Для начала немного ясности с тем как описываются методы в 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 ничем тут не помогут.
:(

---

← →
DarkGreen   (2002-09-19 05:24) [13]

Стоим :-)
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] //Вот и вызов метода ни каких поисков


---

Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2002.09.30;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.51 MB
Время: 0.009 c