Object's VMT

[ZerstoreN]

Господа, кто-то в курсе, что там в vmt у объекта?
Во 1-х эта структура явно не соответствует тому, что изложено в хелпе и тому что находится в исходниках компилятора (как минимум, имени типа там нет) - но меня это сейчас не особо интересует, интересует ссылка на парента, с целью сделать аналог проверки instance-of для object-типов. Вопросы зачем это нужно и почему не используются классы, давайте пожалуйста оставим за пределами данной темы.
Опытным путём установлено что бывает 2 варианта vmt, точнее, 2 способа ссылки на parent - прямой и через ещё 1 поинтер, т.е. 1) vmt.parent = @parentvmt и 2) vmt.parent = @какая-то_хрень, какая-то_хрень = @parentvmt.
Хотелось бы понять, при каких условиях компилятор формирует эти варианты и как их легально отличить друг от друга.
Сейчас проверяю по размеру объекта, который там с негативным знаком дублируется, но это же как бы опасно, можно и sigsegv огрести, т.к. два sizeint-а больше 1 поинтера.

Добавлено спустя 2 часа 4 минуты 43 секунды:
В общем выкопал, вопрос закрыт:

Код: Выделить всё

     vParentRef: {$ifdef VER3_0}PVmt{$else}PPVmt{$endif};

[zub]

>>явно не соответствует тому, что изложено в хелпе и тому что находится в исходниках компилятора (как минимум, имени типа там нет)
определения TVMT для классов и обжектов отличаются. ты смотришь определение для классов.

емнип:
Определение TVMT для обжектов в исходниках было, но наружу его не выдернуть - в секции implementations.
Состоит из размер_объекта,-размер_объекта;указатель_на_вмт_родителя;[виртуальные методы]

Добавлено спустя 11 минут 42 секунды:
а вот и определение (ppsrc\packages\rtl-extra\src\inc\objects.pp )

Код: Выделить всё

   VMT=RECORD
     Size,NegSize:Longint;
     ParentLink:PVMT;
   END;

оно не "первичное", т.е. сам компилятор его не использует, с помощью него можно пробежаться по парентам

[ZerstoreN]

Это определение из весии 3.0, из в версии 3.1.1 оно приведено в ОП-посте.
Однако у меня на 2х пека стоит 3.1.1 разных версий, в старой в паренте PVmt вместо PPVmt, поэтому я был в некотором замешательстве.
Сейчас пересоберу.

[zub]

>>Это определение из весии 3.0, из в версии 3.1.1 оно приведено в ОП-посте.
AV в моем парсере. спсб.
Давайте както попонятней, с сылками на исходники

[ZerstoreN]

Да ладно, в принципе-то понятно в чем дело.

https://svn.freepascal.org/svn/fpc/trun ... bjpash.inc

[zub]

Это VMT классов.
Незнаю, у меня приблуда для ковыряния в вмт написана лет 8-10 назад. С тех пор работает, такчто наврятли были терки с pvmt и ppvmt, все давно устаканено

[ZerstoreN]

Ну де-факто сейчас там PPVmt, собрал проверил ( уже 3.3.1 оказывается, быстро дело идет).

[zub]

Минимальный пример дай?

[ZerstoreN]

Код: Выделить всё

type
            
            vmtRecPtr = ^vmtRec;
            vmtRecPtrPtr = ^vmtRecPtr;
            
            vmtRec = packed object 
              size, 
              negSize : sizeint; 
              parent: {$ifdef VER3_0}vmtRecPtr{$else}vmtRecPtrPtr{$endif};
              end;

function    inherits( typemt, parentmt :pointer ): boolean;
var         pp : vmtRecPtrPtr;
            begin
            while (typemt <> nil) do
              begin
              if typemt = parentmt then
                begin
                result := true;
                exit
                end;
              {$ifdef VER3_0}
              typemt := vmtRecPtr( typemt )^.parent;
              {$else}
              pp := vmtRecPtr( typemt )^.parent;
              if (pp <> nil) then
                typemt := pp^
              else
                typemt := nil;
              {$endif};
              end;
              
            result := false;
            end;

function    inherits( typemt, parentmt :pointer ): boolean;
var         pp : vmtRecPtrPtr;
            begin
            while (typemt <> nil) do
              begin
              if typemt = parentmt then
                begin
                result := true;
                exit
                end;
              {$ifdef VER3_0}
              typemt := vmtRecPtr( typemt )^.parent;
              {$else}
              pp := vmtRecPtr( typemt )^.parent;
              if (pp <> nil) then
                typemt := pp^
              else
                typemt := nil;
              {$endif};
              end;
              
            result := false;
            end;

             
type        typea = packed object
              procedure dummy; virtual; abstract;
              end;
              
            typeb = packed object( typea )
              end;

            begin
            inherits( typeof( typeb ), typeof( typea ));
            end.

[zub]

да, согласен PPVmt

Добавлено спустя 5 минут 18 секунд:
и соответственно TObject из objects не работает. нужно запостить баг. Возметесь как нашедший?

Код: Выделить всё

program Project1;
uses
  objects;
type
  PTObj=^TObj;
  TObj=object(TObject)
  end;
  TObj2=object(TObj)
  end;
  TObj3=object(TObj2)
  end;
  TObj4=object(TObj3)
  end;
  TObj5=object(TObj4)
  end;
  TObj6=object(TObj5)
  end;
  TSuperObj=object(TObj)
  end;

var
  t6:TObj6;

begin
  t6.init;
  writeln(t6.Is_Object(TypeOf(TObj)));
  writeln(t6.Is_Object(TypeOf(TSuperObj)));
  readln;
end. 

[ZerstoreN]

Не, я очень ленивый.

[zub]

>>Не, я очень ленивый.
херова тебе.

https://bugs.freepascal.org/view.php?id=34239

Добавлено спустя 10 часов 12 минут 51 секунду:
про публикацию структуры vmt выделил отдельно
https://bugs.freepascal.org/view.php?id=34243

[ZerstoreN]

Если бы мы здесь не были ленивые, давно перешли бы на Rust или C++