Extended Class RTTI

As has been mentioned earlier, Delphi (since version 7) supports extended RTTI on the methods of a class - by compiling the class with $METHODINFO ON defined. This RTTI includes the signature information of the public and published methods. Delphi uses this to implement scripting of Delphi code in the WebSnap framework - see ObjAuto and friends for the details.

I have now been able to write my own types and routines to dig down and get hold of the extended class RTTI into a format that can easily be used for external consumption. As usual my sample app simply dumps out the source code declaration of a sample class.

While writing the HVMethodInfoClasses unit I refactored some of the earlier code and structures so that I could use as much common code with HVIntefaceMethods and HVMethodSignature.

We're getting used to this RTTI digging now, so lets go through the new code quickly. First there are the additional implementation-detail structures defining the approximate layout of the RTTI the compiler generates - gleaned from the "official" source in ObjAuto.

type
  PReturnInfo = ^TReturnInfo;
  TReturnInfo = packed record
    Version: Byte; 
    CallingConvention: TCallConv;
    ReturnType: PPTypeInfo;
    ParamSize: Word;
  end;
  PParamInfo = ^TParamInfo;
  TParamInfo = packed record
    Flags: TParamFlags;
    ParamType: PPTypeInfo;
    Access: Word;
    Name: ShortString;
  end;

Exactly how to find where these structures start is a little subtle. Remember back to the Under the hood of published methods article? At the time I wrote the following (ignorant to the existence of the $MethodInfo directive and extended class RTTI):

"As you can see above the published method table now has the type PPmt. It points to a record that contains the number of published methods in this class followed by a packed array of TPublishedMethod records. Each record contains a size (used to find the start of the next record), a pointer to the address of the method and a packed shortstring containing the name of the method.
Notice that it appears that the Size field would have been unnecessary. In all my testing the value of Size has always been equal to the expression:

  Size :=  SizeOf(Size) + SizeOf(Address) + SizeOf(Name[0]) + Length(Name);

In other words, the next TPublishedMethod record starts just after the last byte of the method name. I’m not sure why Borland decided to add the Size field, but one possible reason might be to be able to extend the contents of the TPublishedMethod record in the future. One natural extension would be to include information about the parameters and calling convention of the method. Then Size would be adjusted accordingly and old code unaware of the new fields would still work fine"

It turns out that the Size field is indeed used to pack up the TReturnInfo and TParamInfo records just following the Name field of the TPublishedMethod record.

type
  PPublishedMethod = ^TPublishedMethod;
  TPublishedMethod = packed record
    Size: word;  
    Address: Pointer;
    Name: {packed} Shortstring;
  end;

To find and decode the method's signature we have to collect the number of extra bytes as indicated by the Size field. We'll see the code for that shortly.

First, here is the easy to use structure that will hold the decoded RTTI for a single class, including all public/published methods with all their parameters and return types.

type
  // Easy-to-use fixed size structure
  PClassInfo = ^TClassInfo;
  TClassInfo = record
    UnitName: string; 
    Name: string;
    ClassType: TClass;
    ParentClass: TClass;
    MethodCount: Word;
    Methods: array of TMethodSignature;  
  end;

That should be largely self-documenting. As you can see have have reused the same TMethodSignature record as we used for interfaces. Who said you have to write OOP to do re-use ;)? All right, now we're more or less ready to write the actual code to convert a typeinfo of a class to the TClassInfo structure above. This implies getting our hands dirty by iterating over all public/published methods and over all extra RTTI info for each method containing signature info. After a little trial-and-error and a couple of peeks into ObjAuto, I ended up with the following code.

function ClassOfTypeInfo(P: PPTypeInfo): TClass;
begin
  Result := nil;
  if Assigned(P) and (P^.Kind = tkClass) then
    Result := GetTypeData(P^).ClassType;
end;  
  
procedure GetClassInfo(ClassTypeInfo: PTypeInfo; 
  var ClassInfo: TClassInfo);
// Converts from raw RTTI structures to user-friendly Info structures
var
  TypeData: PTypeData;
  i, j: integer;
  MethodInfo: PMethodSignature;
  PublishedMethod: PPublishedMethod;
  MethodParam: PMethodParam;
  ReturnRTTI: PReturnInfo;
  ParameterRTTI: PParamInfo;
  SignatureEnd: Pointer;
begin
  Assert(Assigned(ClassTypeInfo));
  Assert(ClassTypeInfo.Kind = tkClass);
  // Class
  TypeData  := GetTypeData(ClassTypeInfo);
  ClassInfo.UnitName        := TypeData.UnitName;
  ClassInfo.ClassType       := TypeData.ClassType;
  ClassInfo.Name            := TypeData.ClassType.ClassName;
  ClassInfo.ParentClass     := ClassOfTypeInfo(TypeData.ParentInfo);  
  ClassInfo.MethodCount     := GetPublishedMethodCount(ClassInfo.ClassType);
  SetLength(ClassInfo.Methods, ClassInfo.MethodCount);
  // Methods
  PublishedMethod := GetFirstPublishedMethod(ClassInfo.ClassType);
  for i := Low(ClassInfo.Methods) to High(ClassInfo.Methods) do
  begin
    // Method
    MethodInfo := @ClassInfo.Methods[i];
    MethodInfo.Name       := PublishedMethod.Name;
    MethodInfo.Address    := PublishedMethod.Address;
    MethodInfo.MethodKind := mkProcedure; // Assume procedure by default
    
    // Return info and calling convention
    ReturnRTTI := Skip(@PublishedMethod.Name);
    SignatureEnd := Pointer(Cardinal(PublishedMethod) 
      + PublishedMethod.Size);
    if Cardinal(ReturnRTTI) >= Cardinal(SignatureEnd) then
    begin
      MethodInfo.CallConv := ccReg; // Assume register calling convention 
      MethodInfo.HasSignatureRTTI := False;
    end
    else  
    begin
      MethodInfo.ResultTypeInfo := Dereference(ReturnRTTI.ReturnType);
      if Assigned(MethodInfo.ResultTypeInfo) then 
      begin
        MethodInfo.MethodKind := mkFunction;
        MethodInfo.ResultTypeName := MethodInfo.ResultTypeInfo.Name;
      end  
      else 
        MethodInfo.MethodKind := mkProcedure;
      MethodInfo.CallConv := ReturnRTTI.CallingConvention;
      MethodInfo.HasSignatureRTTI := True;
      // Count parameters
      ParameterRTTI := Pointer(Cardinal(ReturnRTTI) + SizeOf(ReturnRTTI^));
      MethodInfo.ParamCount := 0;
      while Cardinal(ParameterRTTI) < Cardinal(SignatureEnd) do
      begin
        Inc(MethodInfo.ParamCount); // Assume less than 255 parameters ;)!
        ParameterRTTI := Skip(@ParameterRTTI.Name);
      end;  
      // Read parameter info
      ParameterRTTI := Pointer(Cardinal(ReturnRTTI) + SizeOf(ReturnRTTI^));
      SetLength(MethodInfo.Parameters, MethodInfo.ParamCount);
      for j := Low(MethodInfo.Parameters) to High(MethodInfo.Parameters) do
      begin
        MethodParam := @MethodInfo.Parameters[j];
        MethodParam.Flags      := ParameterRTTI.Flags;
        if pfResult in MethodParam.Flags 
        then MethodParam.ParamName  := 'Result'
        else MethodParam.ParamName  := ParameterRTTI.Name;
        MethodParam.TypeInfo   := Dereference(ParameterRTTI.ParamType);
        if Assigned(MethodParam.TypeInfo) then
          MethodParam.TypeName := MethodParam.TypeInfo.Name;
        MethodParam.Location   := TParamLocation(ParameterRTTI.Access);
        ParameterRTTI := Skip(@ParameterRTTI.Name);
      end;  
    end;
    PublishedMethod := GetNextPublishedMethod(ClassInfo.ClassType, 
      PublishedMethod);
  end;  
end;  

As usual we test the code by defining some silly code and use RTTI to reconstruct the source of a class declaration. Here is the simplified test project.

program TestHVMethodInfoClasses;
 
{$APPTYPE CONSOLE}
 
uses
  SysUtils,
  TypInfo,
  HVMethodSignature in 'HVMethodSignature.pas',
  HVMethodInfoClasses in 'HVMethodInfoClasses.pas';

procedure DumpClass(ClassTypeInfo: PTypeInfo);
var
  ClassInfo: TClassInfo;
  i: integer;
begin
  GetClassInfo(ClassTypeInfo, ClassInfo);
  writeln('unit ', ClassInfo.UnitName, ';');
  writeln('type');
  write('  ', ClassInfo.Name, ' = '); 
    write('class');
    if Assigned(ClassInfo.ParentClass) then
      write(' (', ClassInfo.ParentClass.ClassName, ')');
    writeln;
  for i := Low(ClassInfo.Methods) to High(ClassInfo.Methods) do
    writeln('    ', MethodSignatureToString(ClassInfo.Methods[i]));
  writeln('  end;');
  writeln;
end;  

type
  {$METHODINFO OFF}
  TNormalClass = class
  end;
  TSetOfByte = set of byte;
  TEnum = (enOne, enTwo, enThree);
type
  {$METHODINFO ON}
  TMyClass = class
  public
    function Test1(const A: string): string; 
    function Test2(const A: string): byte;
    procedure Test3(R: integer);
    procedure Test4(R: TObject); 
    procedure Test5(R: TNormalClass); 
    procedure Test6(R: TSetOfByte); 
    procedure Test7(R: shortstring); 
    procedure Test8(R: openstring); 
    procedure Test9(R: TEnum); 
    function Test10: TNormalClass; 
    function Test11: integer; 
    function Test18: shortstring; 
    function Test19: TObject; 
    function Test20: IInterface; 
    function Test21: TSetOfByte; 
    function Test22: TEnum; 
  end;
 
//... Dummy implementations of TMyClass methods left out...

procedure Test;
begin
  DumpClass(TypeInfo(TMyClass));
end;

begin
  try
    Test;
  except
    on E:Exception do
      writeln(E.Message);
  end;
  readln;
end.

 And the output of the program is:

unit TestHVMethodInfoClasses;
type
  TMyClass = class (TObject)
    function Test1(A: String): String;
    function Test2(A: String): Byte;
    procedure Test3(R: Integer);
    procedure Test4(R: TObject);
    procedure Test5(R: TNormalClass);
    procedure Test6(R: TSetOfByte);
    procedure Test7(R: ShortString);
    procedure Test8(R: ShortString);
    procedure Test9(R: TEnum);
    function Test10(): TNormalClass;
    function Test11(): Integer;
    function Test18(): ShortString;
    function Test19(): TObject;
    function Test20(): IInterface;
    function Test21(): TSetOfByte;
    function Test22(): TEnum;
  end;

The full code is available at CodeCentral.

As my diligent reader, Ralf, pointed out the output of this program is not a verbatim copy of the source code. Aside from my sloppiness of not omitting the empty parens in the functions, the A: string parameters are not declared const. This is because the RTTI for those parameters does not include pfConst (duh!). I think the reason is that the method and parameter RTTI is optimized to achieve dynamic run-time calling of methods and a const modifier does not affect the caller - it only influences the code the compiler generates in the implementation of the method (omitting string ref-counting and a try-finally clause).

In fact, I've been (unsuccessfully so far) lobbying Borland DevCo CodeGear to ease up the compiler and allow having const in the implementation section and non-const in the interface. This might sound like a sloppy request, but it would allow changing the const-ness of a parameter without affecting the interface. Oh well, a story for some other time, perhaps.

[PS. This blog post was edited in Windows Live Writer - I like it, although I goofed up and posted this article too early, probably by accidentally pressing Ctrl+P = publish post ;)].

Updated (27. Oct 2007): $METHODINFO was first available in Delphi 7, not Delphi 6.