Notice: Undefined index: HTTPS in /home/developpez/www/developpez-com/template/entete.php on line 28
Construire une procédure pointant sur une méthode en Delphi

Construire une procédure pointant sur une méthode


précédentsommaire

XIII. Pour aller plus loin : se servir de ObjAuto

Cette section suppose l'utilisation d'une version 2005 ou supérieure de Delphi.

Je ne vous cacherai pas que je suis resté déçu de mon implémentation de MakeProcOfRegisterMethod. En effet, celle-ci ne peut fonctionner si l'on ne renseigne pas correctement le nombre de registres utilisés, ainsi que la taille de la pile à déplacer. D'autre part, si la signature des méthodes et routines mises en jeu change, il faut également modifier l'appel à MakeProcOfRegisterMethod.

J'ai donc fouillé un peu plus profondément dans les unités système de Delphi, et j'ai trouvé une unité fort intéressante : l'unité ObjAuto.pas. Et avec elle la directive {$METHODINFO ON/OFF}

Pour cette section, un pré-requis supplémentaire est de connaître les RTTI de base des méthodes publiées, activées avec la directive {$TYPEINFO ON} ou {$M+}. La directive {$METHODINFO ON} ajoute, en plus de ces RTTI de base, des informations détaillées sur les méthodes.

Les cas dans lesquels il est possible de profiter de ce que nous allons voir ici sont très rares. Et je n'ai moi-même pas encore pu imaginer de telle situation. Je vous entraîne ici seulement dans un de mes plaisirs : explorer le langage Delphi plus loin que personne d'autre ;-)
Donc soit vous vous faites plaisir en lisant cette annexe, soit ne la lisez pas : vous en seriez déçu.

XIII-A. L'unité ObjAuto

L'unité ObjAuto définit trois structures qui permettent de lire ces RTTI.

 
Sélectionnez

type
  TCallingConvention = (ccRegister, ccCdecl, ccPascal, ccStdCall, ccSafeCall);

  TParamFlags = set of (pfVar, pfConst, pfArray, pfAddress, pfReference, pfOut,
    pfResult);

  PMethodInfoHeader = ^TMethodInfoHeader;
  TMethodInfoHeader = packed record
    Len: Word;
    Addr: Pointer;
    Name: ShortString;
  end;

  PReturnInfo = ^TReturnInfo;
  TReturnInfo = packed record
    Version: Byte; // Must be 1
    CallingConvention: TCallingConvention;
    ReturnType: PPTypeInfo;
    ParamSize: Word;
  end;

  PParamInfo = ^TParamInfo;
  TParamInfo = packed record
    Flags: TParamFlags;
    ParamType: PPTypeInfo;
    Access: Word;
    Name: ShortString;
  end;
				

Tout comme au sein des RTTI des types de données, les ShortString sont ici ce que j'ai coutume d'appeler des packed ShortString. Elles n'ont que la taille strictement utile, donc leur longueur + 1 en octets.

Pour "commencer", on récupère un header de type PMethodInfoHeader au moyen de la routine GetMethodInfo déclarée dans cette même unité.

 
Sélectionnez

function GetMethodInfo(Instance: TObject;
  const MethodName: ShortString): PMethodInfoHeader;
				

Si les RTTI étendues (METHODINFO) ont été activées, la structure TMethodInfoHeader est suivie en mémoire d'une structure TReturnInfo, elle-même suivie d'autant de TParamInfo que la méthode a de paramètres.

L'unité ObjAuto propose encore quelques routines qui ne nous intéressent pas ici.

XIII-B. Naviguer dans les RTTI étendues

Pour pouvoir "passer au-dessus" des packed ShortString, nous utiliserons la routine suivante :

 
Sélectionnez

function SkipPackedShortString(Value: PShortstring): Pointer; inline;
begin
  Result := Pointer(Integer(Value) + PByte(Value)^ + 1);
end;
				

Pour les versions ne supportant pas l'inlining, voici une alternative en assembleur, inspirée de TypInfo.GetTypeData :

 
Sélectionnez

function SkipPackedShortString(Value: PShortstring): Pointer;
asm
        { ->    EAX Pointer to a packed ShortString                   }
        { <-    EAX Pointer to data following this packed ShortString }
        XOR     EDX,EDX
        MOV     DL,[EAX]
        LEA     EAX,[EAX].Byte[EDX+1]
end;
				

Avec cette routine, il est plus facile de naviguer dans les RTTI avancées.

Puisqu'il n'existe pas de champ indiquant le nombre de paramètres, il faut jouer sur le champ Len de TMethodInfoHeader : parcourir les paramètres jusqu'à dépasser la taille des RTTI avancées.

Voici un code basique parcourant ces données.

 
Sélectionnez

var
  MethodInfo: PMethodInfoHeader;
  InfoEnd: Pointer;
  ReturnInfo: PReturnInfo;
  ParamInfo: PParamInfo;
begin
  MethodInfo := GetMethodInfo(SomeObject, 'SomeMethod');
  InfoEnd := Pointer(Integer(MethodInfo) + MethodInfo.Len);
  ReturnInfo := SkipPackedShortString(@MethodInfo.Name);
  ParamInfo := PParamInfo(Integer(ReturnInfo) + SizeOf(TReturnInfo));

  while Cardinal(ParamInfo) < Cardinal(InfoEnd) do
  begin
    DoSomethingWithParamInfo;
    
    ParamInfo := SkipPackedShortString(@ParamInfo.Name);
  end;
end;
				

On peut l'appliquer à un objet SomeObject de type TSomeClass, ressemblant à ceci :

 
Sélectionnez

type
  {$METHODINFO ON}
  TSomeClass = class
  public
    function SomeMethod(Param: Integer): Boolean;
  end;
  {$METHODINFO OFF}
				

XIII-C. Une unique routine avec CallingConvention

Une information des plus intéressantes est le champ CallingConvention de TReturnInfo. Il va en effet nous permettre de centraliser les quatre routines MakeProcOfXXXMethod en une seule.

Le code de cette routine MakeProcOfAutoMethod est somme toute basique. La seule difficulté réside dans les méthodes register, pour lesquelles on délèguera à une autre routine GetAutoRegisterInfo la tâche ingrate de déterminer UsedRegCount et MoveStackCount. Cette routine sera développée dans les sections suivantes.

 
Sélectionnez

function MakeProcOfAutoMethod(Self: Pointer;
  MethodInfo: PMethodInfoHeader): Pointer;
var
  Method: TMethod;
  ReturnInfo: PReturnInfo;
  UsedRegCount: Byte;
  MoveStackCount: Word;
begin
  Method := MakeMethod(MethodInfo.Addr, Self);

  ReturnInfo := SkipPackedShortString(@MethodInfo.Name);
  Assert(Cardinal(ReturnInfo) < Cardinal(MethodInfo) + MethodInfo.Len);
  Assert(ReturnInfo.Version = 1);

  case ReturnInfo.CallingConvention of
    ccRegister:
    begin
      GetAutoRegisterInfo(MethodInfo, UsedRegCount, MoveStackCount);
      Result := MakeProcOfRegisterMethod(Method, UsedRegCount, MoveStackCount);
    end;
    ccCdecl: Result := MakeProcOfCDeclMethod(Method);
    ccPascal: Result := MakeProcOfPascalMethod(Method);
    ccStdCall, ccSafeCall: Result := MakeProcOfStdCallMethod(Method);
    else Result := nil; // should never get here
  end;
end;
				

Vous aurez remarqué l'assertion portant sur l'adresse de ReturnInfo. Le rôle de cette assertion est de vérifier que la méthode en question a été compilée avec {$METHODINFO ON}. Si ce n'était pas le cas, les RTTI seraient cantonnées à l'adresse et au nom de la fonction. Ces informations sont exploitées par les méthodes MethodAddress et MethodName de TObject.
La seconde assertion sert à vérifier la "version" des RTTI étendues. À ce jour, on en est toujours à la version 1. Mais si Borland a prévu ce champ, c'est parce qu'ils ont en tête de possibles changements futurs.

XIII-D. Compter le nombre de registres utilisés par la méthode

N'allons pas trop vite, et commençons par compter le nombre de registres utilisés. Et encore ! Nous allons compter le nombre de registres utilisés pour l'appel de la méthode. Il s'avère que ce comptage est vraiment facile.

En effet, la structure TParamInfo comporte le champ Access, qui indique la façon dont est transmise (et récupérée) un paramètre. Ce champ a deux types de valeurs possibles. Soit il vaut paEAX, paEDX ou paECX, indiquant le registre utilisé pour le transmettre. Soit il vaut une valeur supérieure et divisible par 4, indiquant sa position dans la pile.

La position dans la pile est "optimisée" pour la récupération des paramètres. Cela se traduit par le fait qu'elle vaut 8 octets "de trop". Ces 8 octets sont ceux pris par les empilements respectifs de l'adresse de retour et du registre EBP.

Pour compter les registres, il suffit donc de compter les paramètres dont la valeur Access est strictement inférieure à paStack.

 
Sélectionnez

procedure GetAutoRegisterInfo(MethodInfo: PMethodInfoHeader;
  out UsedRegCount: Byte; out MoveStackCount: Word);
var
  InfoEnd: Pointer;
  ReturnInfo: PReturnInfo;
  ParamInfo: PParamInfo;
begin
  InfoEnd := Pointer(Integer(MethodInfo) + MethodInfo.Len);
  ReturnInfo := SkipPackedShortString(@MethodInfo.Name);
  ParamInfo := PParamInfo(Integer(ReturnInfo) + SizeOf(TReturnInfo));

  // Compute UsedRegCount (for the method, not for the procedure!)
  UsedRegCount := 0;
  while (UsedRegCount < 3) and (Cardinal(ParamInfo) < Cardinal(InfoEnd)) do
  begin
    if ParamInfo.Access < paStack then
      Inc(UsedRegCount);
    ParamInfo := SkipPackedShortString(@ParamInfo.Name);
  end;

  ...
end;
				

XIII-E. Déterminer le paramètre stocké par ECX dans la procédure

L'étape suivante est de déterminer le paramètre qui est stocké dans ECX dans l'appel de procédure. Rappelez-vous les difficultés de la convention register, c'était ce paramètre qui jouait un rôle déterminant.

Un réflexe est de dire que ce paramètre est celui qui suit immédiatement la paramètre stocké dans ECX pour la méthode. Malheureusement, ce n'est pas tout à fait vrai. Il se peut en effet qu'il existe des paramètres qui soient toujours passés par la pile, et qui donc ne peuvent être passés dans ECX. Il faut trouver un moyen de les ignorer.

Rappelons les règles qui déterminent si un paramètre doit être passé par la pile. Il doit l'être s'il est de type flottant, méthode ou Int64, et s'il n'est ni var ni out. Il se trouve que les champs Flags et ParamType de TParamInfo permettent d'obtenir ces informations.

Flags est un ensemble de valeurs dont 3 nous intéressent ici : pfVar, pfOut et pfResult. Si l'une de ces trois valeurs est inclue dans cet ensemble, alors le paramètre est passé par référence, et quelque soit son type, il peut être passé dans un registre. pfVar et pfOut ont un sens évident. pfResult lui, est présent lorsque ParamInfo pointe sur le pseudo-paramètre qui contient l'adresse où enregistrer la valeur de retour. Il n'est présent que lorsque cette valeur est effectivement retournée via un emplacement mémoire alloué par l'appelant.

ParamType pointe sur les RTTI du type du paramètre. On peut tester si la valeur Kind fait partie de l'ensemble [tkFloat, tkMethod, tkInt64] et, le cas échéant, exiger un passage sur la pile.

Cela nous conduit à la petite routine ci-dessous :

 
Sélectionnez

function NeedStack(ParamInfo: PParamInfo): Boolean;
const
  RefFlags = [pfVar, pfOut, pfResult];
  StackKinds = [tkFloat, tkMethod, tkInt64];
begin
  Result := (ParamInfo.Flags * RefFlags = []) and
    (ParamInfo.ParamType^.Kind in StackKinds);
end;
				

Pour rappel, l'opérateur * employé avec des opérandes d'un type ensemble construit l'intersection entre les deux opérandes.

Nous pouvons donc maintenant facilement identifier le paramètre qui sera stocké dans ECX dans la procédure. En sortie du code déjà donné, la variable ParamInfo pointe sur le paramètre suivant directement celui stocké dans ECX dans la méthode. Il est donc aussi le premier candidat à être le paramètre passé dans ECX dans la procédure.

Il suffit de boucler jusqu'à arriver à la fin des paramètres ou à trouver un paramètre qui accepte d'être passé par registre.

 
Sélectionnez

  ...
  // Skip parameters that need to be passed by stack
  while (Cardinal(ParamInfo) < Cardinal(InfoEnd)) and NeedStack(ParamInfo) do
    ParamInfo := SkipPackedShortString(@ParamInfo.Name);
  ...
				

XIII-F. Le final

La fin est toute proche. Il reste à différencier deux cas de figure.

Le premier est si l'on a atteint la fin des paramètres. Dans ce cas, il n'y a aucun paramètre stocké dans ECX dans la procédure. Il faut alors décrémenter UsedRegCount, puisque dans la procédure on utilise un registre de moins (le Self) et on en n'a pas de plus. Accessoirement, MoveStackCount vaut 0.

 
Sélectionnez

  ...
  // If there are no more parameters, the procedure will have 1 used reg less
  if Cardinal(ParamInfo) >= Cardinal(InfoEnd) then
  begin
    Dec(UsedRegCount);
    MoveStackCount := 0;
  end else
  ...
				

Dans le cas contraire, UsedRegCount vaut forcément 3, et doit le rester. Il faut alors déterminer MoveStackCount. Pour cela, nous nous servons pour la seconde fois de l'information stockée dans le champ Access de TParamInfo.

Cette fois il s'agit dans tous les cas de l'offset par rapport au bas de la pile, en récupération. Il se trouve qu'il s'agit exactement du nombre d'octets dont il faut déplacer la pile (+ 8 pour l'adresse de retour et EBP). En outre, il faut diviser cette donnée par 4 puisque MoveStackCount se compte en cases, et non en octets.

 
Sélectionnez

  ...
  // Otherwise, UsedRegCount = 3 and
  //   MoveStackCount can be found in ParamInfo.Access, because ParamInfo
  //   points to the parameter stored in ECX in the procedure
  begin
    MoveStackCount := ParamInfo.Access div 4;
    Dec(MoveStackCount, 2); // Access numbers include RET and EBP
  end;
end;
				

XIII-G. Code complet de GetAutoRegisterInfo

 
Sélectionnez

procedure GetAutoRegisterInfo(MethodInfo: PMethodInfoHeader;
  out UsedRegCount: Byte; out MoveStackCount: Word);

  function NeedStack(ParamInfo: PParamInfo): Boolean;
  const
    RefFlags = [pfVar, pfOut, pfResult];
    StackKinds = [tkFloat, tkMethod, tkInt64];
  begin
    Result := (ParamInfo.Flags * RefFlags = []) and
      (ParamInfo.ParamType^.Kind in StackKinds);
  end;

var
  InfoEnd: Pointer;
  ReturnInfo: PReturnInfo;
  ParamInfo: PParamInfo;
begin
  InfoEnd := Pointer(Integer(MethodInfo) + MethodInfo.Len);
  ReturnInfo := SkipPackedShortString(@MethodInfo.Name);
  ParamInfo := PParamInfo(Integer(ReturnInfo) + SizeOf(TReturnInfo));

  // Compute UsedRegCount (for the method, not for the procedure!)
  UsedRegCount := 0;
  while (UsedRegCount < 3) and (Cardinal(ParamInfo) < Cardinal(InfoEnd)) do
  begin
    if ParamInfo.Access < paStack then
      Inc(UsedRegCount);
    ParamInfo := SkipPackedShortString(@ParamInfo.Name);
  end;

  // Skip parameters that need to be passed by stack
  while (Cardinal(ParamInfo) < Cardinal(InfoEnd)) and NeedStack(ParamInfo) do
    ParamInfo := SkipPackedShortString(@ParamInfo.Name);

  // If there are no more parameters, the procedure will have 1 used reg less
  if Cardinal(ParamInfo) >= Cardinal(InfoEnd) then
  begin
    Dec(UsedRegCount);
    MoveStackCount := 0;
  end else

  // Otherwise, UsedRegCount = 3 and
  //   MoveStackCount can be found in ParamInfo.Access, because ParamInfo
  //   points to the parameter stored in ECX in the procedure
  begin
    MoveStackCount := ParamInfo.Access div 4;
    Dec(MoveStackCount, 2); // Access numbers include RET and EBP
  end;
end;
				

précédentsommaire

Tutoriels
Les génériques avec Delphi 2009 Win32 (English version) - également disponible en espagnol et en russe
Réaliser un plug-in comportant un composant
Construire une procédure pointant sur une méthode
Création de composants - en 4 parties
Refactoring avec Delphi 2007
Prise en main de Delphi 2005
Analyseurs syntaxiques - Leur fonctionnement par l'exemple
Créer un fichier d'aide HLP
Pourquoi un paramètre const change-t-il mystérieusement de valeur ?
Sources
SJRDUnits - Routines et classes diverses
SJRDComps - Quelques composants
Projet Sepi
Présentation
FAQ Sepi
Programmes
FunLabyrinthe - Jeu de labyrinthe très spécial et très fun
TrickTakingGame - Jeux de cartes à plis en ligne
MultiAgenda - Agenda multi-répertoires
DecodeFormulaires - Décode les formulaires
Excel --> HTML - Convertisseur de tableaux Excel en HTML
AddressLinks - Lie les adresses Internet et e-mail d'un document HTML
Vipion - Tic Tac Toe sur 4x4 cases avec jeu de l'ordinateur
BigCalc - Calculatrice de haut niveau
Espace paroissial Astérion de Watermael-Boitsfort
  

Notice: Undefined index: HTTPS in /home/developpez/www/developpez-com/template/pied.php on line 5

Les sources présentées sur cette page sont libres de droits et vous pouvez les utiliser à votre convenance. Par contre, la page de présentation constitue une œuvre intellectuelle protégée par les droits d'auteur. Copyright © 2007 Sébastien Doeraene. Aucune reproduction, même partielle, ne peut être faite de ce site et de l'ensemble de son contenu : textes, documents, images, etc. sans l'autorisation expresse de l'auteur. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.