Вот тут случайно втянулся в разрабоку поддержки COM для KOL. KOL - это такая библиотека написанная под Делфи без использования VCL, и что самое заковыристое -  без исползования классов, а на чистом Object Pascal. В это и заключается проблема поддержки COM - в Делфи интервейсы встраиваются в классы, но классов нет нет и интерфейсов. А значит надо за компилятор делать работу по созданию таблиц. Вот код - весь его читать не нужно, если только сами не хотите над это проблемой подумать - нужно обратить внимание на асмовский код в процедурах:

Код

const IUnknown_IID:TGUID='{00000000-0000-0000-C000-000000000046}'; IClassFactory_IID:TGUID='{00000001-0000-0000-C000-000000000046}'; type //Interfaces  IUnknown = object  public    QueryInterface:function(const IID: TGUID; out Obj): HResult; stdcall;    AddRef:function:HResult; stdcall;    Release:function:HResult; stdcall;  end;  PIUnknown=^IUnknown;  InterfaceSet=packed record    _vmt:pointer; //таблица виртуальных методов для интерфейса    this:pointer; //указатель на экземпляр класса, которому интерфейс принадлежит  end;  PInterfaceSet=^InterfaceSet;  IClassFactory = object(IUnknown)    CreateInstance:function(const unkOuter: pointer; const iid: TGUID; out obj): HResult; stdcall;    LockServer:function(fLock: boolean): HResult; stdcall;  end;  PIClassFactory=^IClassFactory;  TInterfaceEntry=packed record    GUID:TGUID;    p:PInterfaceSet;  end;  PInterfaceEntry=^TInterfaceEntry;  TInterfacedObj=object(TObj)  private    //таблица интерфейсов. Фактически, динамический массив из TInterfaceEntry    fInterfaceTable:PInterfaceEntry;    fInterfaceCount:Integer;    //таблица для интерфейса IUnknown    fIUnknown:IUnknown;    fRefCount:Integer;  private    //IUnknown    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;    function AddRef:Longint; stdcall;    function Release:Longint; stdcall;  protected    procedure SetInterfaceTable; virtual;  public    procedure Init; virtual;    procedure AddInterface(IID:TGUID; Ifc:PIUnknown);    function GetInterface(IID:TGUID; out Obj):boolean;  end;  PInterfacedObj=^TInterfacedObj; implementation function GUIDComp(GUID1,GUID2:TGUID):boolean; var  i:integer; begin for i:=0 to 7 do  if GUID1.D4[i]<>GUID2.D4[i] then  begin    Result:=false;    exit;  end; Result:=True and (GUID1.D1=GUID2.D1) and (GUID1.D2=GUID2.D2) and (GUID1.D3=GUID2.D3); end; { TInterfacedObj } procedure TInterfacedObj.AddInterface(IID: TGUID; Ifc: PIUnknown); var  tmp:PInterfaceEntry; begin  if GetInterface(IID,tmp) then     exit;  Inc(fInterfaceCount);  //выделяем новый блок памяти(на один болше) и копируем в него содержимое старого  GetMem(tmp,SizeOf(TInterfaceEntry)*fInterfaceCount);  if fInterfaceTable<>nil then  begin    Move(fInterfaceTable^,tmp^,SizeOf(TInterfaceEntry)*(fInterfaceCount-1));    FreeMem(fInterfaceTable);  end;  fInterfaceTable:=tmp;  //в новую выделенную запись записываем новый интерфейс  inc(tmp,fInterfaceCount-1);  tmp^.GUID:=IID;  New(tmp^.p);  tmp^.p^._vmt:=Ifc;  tmp^.p^.this:=@self; end; function TInterfacedObj.AddRef: Longint; begin asm   mov eax,ebp   add eax,$08   mov edx,[eax]   add edx,$04   mov edx,[edx]   mov [eax],edx end; Result := InterlockedIncrement(FRefCount); end; function TInterfacedObj.GetInterface(IID: TGUID; out Obj): boolean; var  Entry:PInterfaceEntry;  i:integer; begin Result:=false; Entry:=fInterfaceTable; for i:=1 to fInterfaceCount do begin   if GUIDComp(Entry^.GUID,IID) then   begin     Result:=True;     Pointer(Obj):=Entry^.p;     exit;   end;   inc(Entry); end; end; procedure TInterfacedObj.Init; begin fInterfaceTable:=nil; fInterfaceCount:=0; fRefCount:=0; SetInterfaceTable; end; function TInterfacedObj.QueryInterface(const IID: TGUID; out Obj): HResult; begin  asm    mov eax,ebp    add eax,$08    mov edx,[eax]    add edx,$04    mov edx,[edx]    mov [eax],edx  end;  if GetInterface(IID,Obj) then  begin    InterlockedIncrement(FRefCount);    Result:=S_OK;  end  else    Result:=E_NOINTERFACE; end; function TInterfacedObj.Release: Longint; begin  asm    mov eax,ebp    add eax,$08    mov edx,[eax]    add edx,$04    mov edx,[edx]    mov [eax],edx  end; Result := InterlockedDecrement(FRefCount); if Result = 0 then   Dispose(@self); end; procedure TInterfacedObj.SetInterfaceTable; begin //заполняем таблицу with fIUnknown do begin   QueryInterface:[email protected];   AddRef:[email protected];   Release:[email protected]; end; AddInterface(IUnknown_IID,@fIUnknown); end;

В чем хитрость? Хитрость в том, что я передаю указатель на подставной объект (InterfaceSet), который якобы имеет таблицу виртуальных методов. На самом деле, эта таблица набор указателей, значения которых являются адресами методов главного объекта (самый последний метод в листинге). Так вот дело в том, что метод-то по адресу вызывается тот что нужен, но в параметре self естесственно передается указатель на мой подставной объект, а не на реальный. Но в подставном объекте я храню указатель, на реальный объект, и код на асме в каждом методе как раз для того, чтобы переписать self этим правильным значением. Но асм то я не знаю. Вот и вопрос - можно это как-нибудь упростить? Лучше всего конечно обернуть это в функцию, но без асмовской вставки, кажись, все равно не обойтись. Будут идеи?

Не знаю, что все это извращение означает, оптимизация тут не причем: скорее, обходятся стандартные ограничения языка (разнотипные присваиваивания и т.п.). Вот попытка упростить этот код:

Цитата

function TInterfacedObj.AddRef: Longint; begin asm  mov eax,ebp  add eax,$08  mov edx,[eax]  add edx,$04  mov edx,[edx]  mov [eax],edx end; Result := InterlockedIncrement(FRefCount); end;

Образно говоря, делается следующее: Данную функцию можно представить себе как ф-цию, получающую как минимум один параметр типа long(4 байта). Скорее всего это указатель на что-то:

function TInterfacedObj.AddRef: Longint; <=> function TestFunc(...Pn): Longint;

При этом ПОСЛЕДНИЙ (или вообще один) параметр я называю Pn.

Далее делается следующее:

- Получается ЗНАЧЕНИЕ этого параметра Pn:

 mov eax,ebp  ; Получить указатель на стековый фрейм eax->Сохраненный ebp
 add eax,$08   ; Указать на параметр Pn
 mov edx,[eax] ; Получит его в edx

 И мы получили значение Pn в регистре edx.

-  Судя по всему, далее это значение трактуется как указатель на какую-то структуру (указатели на методы ?) размером по 4 байта (long) и выбирается второй элемент:

 add edx,$04  ; Сослаться на второй элемент (Pn+4)
 mov edx,[edx] ; Получить зачение элемента Table[2] в edx

- После этого на место СТАРОГО параметра Pn, переданного в функцию TestFunc кладется значение этого самого Pn[2]:

mov [eax],edx ; Поместить вместо переданного Pn этот элемент.

Зачем все это нужно, тебе виднее ;)

Что-то я не понял, где тут упрощение.  

Цитата

Образно говоря, делается следующее: Данную функцию можно представить себе как ф-цию, получающую как минимум один параметр типа long(4 байта). Скорее всего это указатель на что-то:

Это, однозначно, указатель на экземпляр класса. Тот что self называется.

Цитата

При этом ПОСЛЕДНИЙ (или вообще один) параметр я называю Pn

Почему последний? Он должен быть первым. Или в том смысле, что он последний в стеке?


Что этот код делает я знаю - я же его сам написал. Асм я, конечно, можно сказать не знаю, но не до такой степени чтобы совсем не понимать. У компилера подсмотрел, как правильно воспользоваться командами mov и add и какие регистры использовать. А в коде делается вот что (я там выше правда уже писал). Посмотри на тип InterfaceSet в самом начале листинга. Член _vmt - это указатель на таблицу указателей. В эти указатели я записываю адреса методов, а клиентский код потом по ним эти методы вызывает.

Код

InterfaceSet {    _vmt------------->pointer1    this                      pointer2                               pointer3                               ..........  }

Если выбросить переменную this, то получиться чистый COM интерфейс. Обычно на него передают указатель, и клиентский код, зная смещения соответсвующих методов, находит правильный указатель на метод. То есть если у нас есть интерфейс IUnknown то по сути это такая структура:

Код

struct IUnknown  {     virtual long int QueryInterface(TGUID iid, void** obj);     virtual long int AddRef();     virtual long int Release();  };

и в памяти она распологается так:

Код

_vmt---------->pointer1------------->QueryInterface                        pointer2----------|                        pointer3---|        |                                       |        |------->AddRef                                       |--->Release

_vmt - это "переменная" генерируется компилятором и является указателем, на первый указатель на метод этого интерфейса. Теперь зная значение _vmt  мы можем вызвать метод AddRef так: мы знаем, что AddRef - это второй метод, а размер указателя 4 байта - берем значение _vmt прибавляем к нему 4 - получаем адрес по которому находиться pointer2, который и содержит адрес метода AddRef. По этому адресу вызываем метод.
В COM мы передаем указатель на этот _vmt. Так что клиент знает этот указатель, и знает в каком порядке расположенны методы - на этой информации он и вызывает нужные методы.
  Но так как это методы, которые принадлежат объекту,
то чтобы знать, для какого объекта этот метод вызывается, компилятором генерируется еще один параметр, который вставляется перед всеми остальными параметрами, и в этом параметре он передает указатель на объект, для которого этот метод был вызван. Например для того же IUnknown откомпилированные функции на самом деле будут выглядеть так:

Код

long int QueryInterface(void* self, TGUID iid, void** obj);     long int AddRef(void* self);     long int Release(void* self);

 В COM это стандартизированно. Теперь клиент знает имеет указатель на _vmt, и в качестве переменной self он и передает этот указатель. То есть вызов AddRef примерно такой (Ipointer - это указатель на _vmt):

Код

vmt=*Ipointer;  pointer2=(*vmt)+4;  poiner2(Ipointer)      //Вызываетc AddRef(Ipointer);

Теперь посмотрим, что делается в методе AddRef:

Код

procedure AddRef  begin     Inc(fRefCount);      end;

Так, как fRefCount - это член класса, то на самом деле это выглядет так:

Код

procedure AddRef(self:pointer)  begin     Inc(self^.fRefCount);    //ну тут компилятор знает смещение до fRefCount.  end;

Я так чувствую, что в общем-то то, о чем я все говорил и так известно. Теперь в чем проблема. Посмотрим на последний метод из моего листинга:

Код

procedure TInterfacedObj.SetInterfaceTable; begin //заполняем таблицу //fIUnknown - это мой  сомодельный(не правильный) тип IUnknown - по сути просто структура с указателями. with fIUnknown do begin  QueryInterface:[email protected];  AddRef:[email protected];  Release:[email protected]; end; AddInterface(IUnknown_IID,@fIUnknown); end;

Как видно, в переменной fIUnknown я создаю как бы создаю виртуальную таблицу - то есть присваиваю указателям значения адресов методов класса
TInterfacedObj. Потом я делаю так:

Код

procedure TInterfacedObject.MakeInterface; var  ifc:InterfaceSet; begin  ifc._vmt:=@fIUnknown;  ifc.this:=@self; end;

И потом, я передаю адрес ifc COM клиенту, как указатель на IUnknown. То есть я создаю таблицу методов в ручную и передаю клиенту. Теперь клиент вызывает с помощью этой таблицы AddRef. А у нас в AddRef делается: Inc(self^.fRefCount)  (это так компилятор это сделал). Но что клиент передаст в качестве self? Естесственно указатель на переменную ifc, который я сам ему вначале и передал. Но мне-то нужен указатель на TInterfacedObject! Ибо в нем эта переменная, которую мне надо поменять. Что делать? У меня в ifc записан указатель на объект TInterfacedObject. Теперь, все что мне нужно, это переписать self этим значением. Для этого я и написал тот код на асме. Теперь представте, что у меня много интерфейсов и методов. Тогда мне в каждом методе придется писать 8 строчек одного и того же асмовского кода. Это не приятно.  Хотелось бы все это записать одной строчкой. Почему в паскале нет макро подстановок! А так хотелось бы функцией тогда - но это кажись без кода на асме все равно не получиться. Переменная self храниться по адресу ebp+8, и легально кажись до этого места никак не добраться. Или я ошибаюсь?

Цитата

Почему в паскале нет макро подстановок! А так хотелось бы функцией тогда - но это кажись без кода на асме все равно не получиться. Переменная self храниться по адресу ebp+8, и легально кажись до этого места никак не добраться. Или я ошибаюсь?

Ну как же, как же, Семен Семеныч ! Не все же только в си есть !

Вот пример:

Текст на старом добром Пасе (в Дельфи все также, я уверен):

Цитата

Procedure AsmCode;inline($90/$90/$90); { 3 nop'а } begin  AsmCode;  writeln('First !');  AsmCode;  writeln('Second !');  AsmCode;  writeln('Last !');  AsmCode;  ReadLn; end.

Т.е. "процедура" AsmCode - это фактически МАКРОС. Вот дамп экзешника:

Цитата

cs:0041 9A9102865E     call   5E86291 {...} {AsmCode;} cs:0046 90             nop cs:0047 90             nop cs:0048 90             nop {writeln('First !');} cs:0049 BF5201       mov    di,0152 cs:004C 1E             push   ds cs:004D 57             push   di cs:004E BF0800      mov    di,0008 cs:0051 0E             push   cs cs:0052 57             push   di cs:0053 31C0           xor    ax,ax cs:0055 50             push   ax cs:0056 9A7006865E     call   5E86670 cs:005B 9ADD05865E     call   5E865DD cs:0060 9A9102865E     call   5E86291 {AsmCode;} cs:0065 90             nop cs:0066 90             nop cs:0067 90             nop {writeln('Second !');} cs:0068 BF5201         mov    di,0152 cs:006B 1E             push   ds cs:006C 57             push   di cs:006D BF1100         mov    di,0011 cs:0070 0E             push   cs cs:0071 57             push   di cs:0072 31C0           xor    ax,ax cs:0074 50             push   ax cs:0075 9A7006865E     call   5E86670 cs:007A 9ADD05865E     call   5E865DD cs:007F 9A9102865E     call   5E86291 {...}

Таким образом, видно как Паскаль выполнил ПОДСТАНОВКУ текста процедуры, а вовсе не ее вызов (call). В твоем случае можно даже упростить твой код:

Цитата

mov eax,ebp   add eax,$08   mov edx,[eax]   add edx,$04   mov edx,[edx]   mov [eax],edx

На следующий:

Цитата

mov eax,[ebp+8] ; 8B 45 08   mov eax,[eax+4] ; 8B 40 04   mov [ebp+8],eax ; 89 45 08

Иначе говоря, на байтики:

Procedure MyTrashCode;inline($8B/$45/$08/$8B/$40/$04/$89/$45/$08);

И вставлять его всюду, где нужно.

А вот это разговор.   Вот за это большое спасибо.
Я, кстати, тоже думал про inline процедуры - где-то я у них в коде видел использования inline. Это конечно, не макрос, но для моего случая должно было подойти. Так вот, полез я в хелп по слову inline - и там было написанно что оно оставленно только  для совместимости и компилятор его игнорирует. Вот облом, подумал я и пошел в форум.

Оператор Inline присутствует с первых версий TurboPascal и во всех версиях Дельфи для выполнения непосредственно машинных комманд.

На самом деле допустим и такой вариант: вызывать ПРОЦЕДУРУ. Те на Паскале это будет выглядеть примерно так:

Цитата

Procedure Change_Param; Begin  Asm    ; Сейчас [ebp+0] указывает на сохраненный ebp от  ; той процедуры, из которой нас вызвали  ; Получим его в eax  mov  eax,[ebp]  ; В момент вызова Change_Param ebp(eax-сейчас)  ; указывало на фрейм Test_Program,  ; а [ebp+8] на указатель на Param1, переданный Test_Program  ; Меняем его на указатель на Param2:  mov  ecx,[eax+8] ; ecx - указывает на Param1  ; Получаем указатель на Param2 - Pointer1  mov  ecx,[ecx+4]  ; Меняем указатели  mov  [eax+8],ecx    End; End; procedure Test_Program(var P:longint); Begin   Change_Param;   Writeln(P); End;

Если ее вызывть так:

Const
; Значения параметров
Param2: Longint = 66;
; та же таблица методов ?
Param1: Longint = 1;
Pointer1: Pointer = @Param2;

Begin

TestProgram(Param1);

То должно вывести число 66 вместо ожидаемого 1.

Набросал тут все это на асме:

Цитата

.386 .model flat, stdcall option casemap :none   ; case sensitive include \masm32\include\windows.inc include \masm32\include\user32.inc include \masm32\include\kernel32.inc includelib \masm32\lib\user32.lib includelib \masm32\lib\kernel32.lib .data ; Значения параметров Param2 dd 66 ; та же таблица методов ? Param1 dd 1 Pointer1 dd offset Param2 .code start: ; Обычно передается указатель на Param1 ; Нам же нужно будет при вызове ПОДМЕНИТЬ ; указатель на указаетль, извлеченный из ; следующих 4-х байт (Pointer1) ; Но за счет вызова Change_Param выведется число 066 ; вместо 001 push offset Param1 call Test_Program invoke ExitProcess,eax Test_Program proc .data TestMsg db "",0 .code  push ebp  mov  ebp,esp  ; Переменная [ebp-8]  ; Число байт [ebp-4]  ; Число байт [ebp-0Ch]  sub  esp,3*4  call Change_Param    ; Значение указателя параметра процедуры Test_Program  mov  eax,[ebp+8]  ; Извлекаем значение (Param1) по указаетелю:  mov  eax,[eax]  ; Выводим значение параметра (eax)  mov  ebx,100  mov  edi,offset TestMsg  call DecChar  invoke MessageBox,0,offset TestMsg,offset TestMsg,MB_OK      leave  ret  4 Test_Program endp Change_Param proc  push ebp  mov  ebp,esp  ; Сейчас [ebp+0] указывает на сохраненный ebp от  ; той процедуры, из которой нас вызвали  ; Получим его в eax  mov  eax,[ebp]  ; В момент вызова Change_Param ebp(eax-сейчас)  ; указывало на фрейм Test_Program,  ; а [ebp+8] на указатель на Param1, переданный Test_Program  ; Меняем его на указатель на Param2:  mov  ecx,[eax+8] ; ecx - указывает на Param1  ; Получаем указатель на Param2 - Pointer1  mov  ecx,[ecx+4]  ; Меняем указатели  mov  [eax+8],ecx    leave  ret Change_Param endp ; ************* DecChar: Подпрограмма форматирования строки из числа *********** ; eax=number to digit, edi=offset result string in format 00000000(@n[ebx]) ; ebx=начальный делитель DecChar proc  pushad  pushfd  cld @GetDec:  xor  edx,edx  div  ebx  add  al,'0'  stosb  push edx  mov  eax,ebx  xor  edx,edx  mov  ebx,10  div  ebx  mov  ebx,eax  pop  eax  test ebx,ebx  jnz  @GetDec  popfd  popad  ret DecChar endp end start

Цитата(Vit @ 21.11.2002, 23:42)

Оператор Inline присутствует с первых версий TurboPascal и во всех версиях Дельфи для выполнения непосредственно машинных комманд.

Забавно, я же говорю набирал inline и нажимаю F1. Выскакивает топик "asm statement" последние предложение перед Remarks:

Цитата

The reserved word "inline" and the directive "assembler" are maintained for backward compatibility only. They have no effect on the compiler.

2Chingachguk: Спасибо, приму к сведению. У меня-то в принципе задача проще, и решение вроде как найдено.

Нет. Не хочет D6 inline жрать. Говорит что ожидает декларашен, а находит inline. Второй способ с вызывом процедуры тоже не работает, почему точно пока не скажу - но что-то там не так записывается. Пока только один способ с непосредственным написанием асмовских строчек в коде работает. Но все оказалось проще - можно просто вынести эти строчки в процедуру. Хоть и происходит call, но значение регистров не меняется, и в стек ничего нового не добавляется, а значит меняется то что нужно.