Construire une procédure pointant sur une méthode en Delphi

La convention d'appel cdecl ressemble très fort à la convention stdcall. La seule différence est que en stdcall, la procédure appelée fait un RET N où N est la taille des paramètres en pile : c'est donc elle qui libère les paramètres en pile. En cdecl, l'appelé fait toujours un RET simple, et c'est l'appelant qui effectue un ADD ESP,N après le CALL : c'est donc l'appelant qui libère les paramètres de la pile.

Cette différence peut sembler bénigne, et pourtant c'est par sa faute que la convention cdecl est la plus difficile à traiter. En effet, le lecteur attentif se souviendra que lorsque nous avons introduit stdcall, nous avons dit que justement, comme l'appelé - qui libère les paramètres - sait bien qu'elle a un paramètre Self, les paramètres sont libérés correctement sans que nous ayons besoin de faire quoi que ce soit.

Ici, ce n'est plus le cas, la routine qui libère les paramètres, c'est l'appelant, et lui ne sait pas qu'il y a un paramètre supplémentaire. Il en libère donc un de moins qu'il n'en faut : si par exemple la procédure a 3 paramètres, alors la méthode en a 4 ; le code d'appel créé par Delphi passe 3 paramètres, et en libère donc 3, or il devrait en libérer 4, car entre-temps on en a ajouté un. C'est le crash assuré dans les instructions qui suivent, car alors la pile est corrompue.

Nous devons donc faire un CALL au lieu d'un JMP, de manière à pouvoir libérer notre paramètre, avant de retourner à l'appelant original. Seulement voilà, si on fait un CALL, on ajoute notre propre adresse de retour dans la pile, et donc tous les paramètres sont décalés pour l'appelé !

Il faut donc écrire notre adresse de retour à la place de l'adresse de retour originale. Mais dans ce cas, nous (notre procédure construite à l'exécution) ne savons plus où retourner après, puisqu'on a perdu cette information. Il faut donc la stocker ailleurs, sans changer l'adresse des paramètres par rapport au bas de la pile.

La première idée qui vient à l'esprit est de réutiliser la méthode de déplacement de mémoire que nous avons utilisée avec register. Mais les routines cdecl ont cette faculté extraordinaire de pouvoir accepter une liste variable de paramètres (les … du C/C++, transposés en Delphi avec le mot-clef varargs). On ne peut donc pas toujours savoir la taille des paramètres à déplacer.

La deuxième idée est de se fixer une limite raisonnable pour la taille des paramètres, par exemple 64*4 = 256 octets, et de déplacer tous ces 256 octets pour aller placer notre information à cet endroit. Cependant, cela déplacerait des données sur lesquelles pourraient éventuellement pointer des adresses passées en paramètre. En fait, c'est extrêmement fréquent. Ce n'est donc pas une solution acceptable.

La troisième solution est donc de stocker cette adresse de retour dans une variable globale. Comme des appels de ce type sont susceptibles d'être imbriqués, il faut en faire une liste (chaînée, sans doute). Et comme chaque thread a sa propre liste d'appels, cette liste doit être stockée dans une variable threadvar.

Pour ne pas surcharger le code des procédures à créer à l'exécution, nous allons nous servir de deux routines utilitaires chargées de stocker et de récupérer la valeur de retour depuis la liste. Pour l'instant, voici leurs prototypes, elles seront détaillées dans la section suivante.

procedure StoreCDeclReturnAddress(ReturnAddress: Pointer); stdcall;
function GetCDeclReturnAddress: Pointer;

Avec ces deux routines supposées définies, le code assembleur des routines à créer ressemble à ceci :

CALL    StoreCDeclReturnAddress
PUSH    CallBackObj
CALL    CallBackMethod
CALL    GetCDeclReturnAddress
JMP     EAX

Simple ? Oui, mais on a oublié un détail : que se passe-t-il si CallBackMethod est une fonction, qui renvoie donc une valeur, et ce potentiellement dans EAX et EDX (ce dernier pour les Int64) ? Les informations sont alors perdues par l'appel à PopCDeclReturnAddress. Il faut donc les sauvegarder quelque part. Ici, la pile semble être le meilleur choix.

CALL    StoreCDeclReturnAddress
PUSH    CallBackObj
CALL    CallBackMethod
PUSH    EAX
POP     EDX
CALL    GetCDeclReturnAddress
POP     EDX
XCHG    EAX,[ESP]
RET

Le XCHG EAX,[ESP] remplit de double rôle de poper EAX et de pusher le résultat de GetCDeclReturnAddress, lui-même réutilisé immédiatement après par le RET. Une autre solution aurait été de sauvegarder ce résultat dans ECX, poper EAX, puis faire un JMP ECX au lieu du RET. Mais cette alternative est plus lente.

Ces routines n'ont rien d'exceptionnel. C'est du Delphi habituel, avec la gestion d'une pile chaînée. Je ne vois pas ici le besoin d'expliquer outre mesure leur fonctionnement.

type
  PCDeclCallInfo = ^TCDeclCallInfo;
  TCDeclCallInfo = packed record
    Previous: PCDeclCallInfo; /// Pointeur vers le contexte précédent
    ReturnAddress: Pointer;   /// Adresse de retour de l'appel
  end;

threadvar
  /// Liste des infos sur les appels cdecl (spécifique à chaque thread)
  CDeclCallInfoList: PCDeclCallInfo;

procedure StoreCDeclReturnAddress(ReturnAddress: Pointer); stdcall;
var
  CurInfo: PCDeclCallInfo;
begin
  New(CurInfo);
  CurInfo.Previous := CDeclCallInfoList;
  CurInfo.ReturnAddress := ReturnAddress;
  CDeclCallInfoList := CurInfo;
end;

function GetCDeclReturnAddress: Pointer;
var
  CurInfo: PCDeclCallInfo;
begin
  CurInfo := CDeclCallInfoList;
  Assert(CurInfo <> nil);
  CDeclCallInfoList := CurInfo.Previous;
  Result := CurInfo.ReturnAddress;
  Dispose(CurInfo);
end;

Fini ? Non. Il reste un problème, et non des moindres…

Delphi est un langage de haut niveau dont une des plus grandes forces, après l'orienté objet et les RTTI, est le mécanisme des exceptions.

Seulement, dans notre cas, ce mécanisme est bien ennuyeux. Une simple exception déclenchée au sein de la méthode appelée va corrompre cette pile d'adresses de retour.

Je vous entends déjà crier : il faut mettre un try..finally autour de l'appel à la méthode ! Je me suis fait la même réflexion, et j'ai tenté de l'implémenter, en assembleur bien sûr.

Des tutoriels existent sur Internet qui expliquent comment fonctionnent les try..finally en assembleur, notamment A Crash Course on the Depths of Win32 : Structured Exception HandlingA Crash Course on the Depths of Win32 : Structured Exception Handling (générique) ou Exception Handling Dans VB6Exception Handling Dans VB6 (orienté VB mais en français). Cependant, avant de vous jeter dessus, sachez que la solution du try..finally n'est pas acceptable ici.

Le problème est que Windows est très paranoïaque dès qu'il a affaire à des exceptions. Il teste si tout est bien comme il a prévu que ce soit. En particulier, il teste si le SEH enregistré est bien dans la pile. Pas de chance, nous n'avons pas le droit d'enregistrer notre SEH sur la pile, pour les mêmes raisons que nous ne pouvions pas y stocker l'adresse de retour. Si l'on tente de l'enregistrer dans le tas, le programme plante littéralement en cas d'exception : Windows croit avoir affaire à un cas de pile corrompue…

Rien à faire, on ne peut donc pas utiliser les try..finally. Il faut trouver une autre astuce.

Puisqu'on ne peut établir de gestionnaire try..finally, on ne peut garantir l'intégrité de la pile de contextes. Afin de pouvoir déterminer jusqu'à quel point la pile est corrompue, nous allons introduire une nouvelle information de contexte dans TCDeclCallInfo.

L'idée est la suivante. Lorsqu'on appelle StoreCDeclReturnAddress, celle-ci identifie les parties corrompues de celle-ci, les supprime, et ensuite seulement enregistre son information. GetCDeclReturnAddress applique le même algorithme, sauf qu'elle vérifie en plus que l'information identifiée valide qu'elle trouve correspond à l'information donnée.

Mais quelle est l'information supplémentaire ? Ma solution est la valeur du registre ESP, le pointeur de pile. En effet, cette valeur diminue strictement au fur à mesure que l'imbrication des appels est profonde. Elle est insensible à la récursion, et est mise à jour par le système de gestion des exceptions de Windows.

Les parties invalides de la pile, ou plutôt la partie invalide, est l'ensemble des enregistrements qui portent une valeur enregistrée de ESP inférieure à la valeur courante de ce registre. Le fait que StoreCDeclReturnAddress supprime les parties corrompues autant que que GetCDeclReturnAddress garantit que la pile des contextes a des éléments dont les valeurs enregistrées de ESP sont strictement croissantes (à partir du haut de la pile).

Nous allons d'abord modifier les routines StoreCDeclReturnAddress et GetCDeclReturnAddress, en leur adjoignant quelques autres routines utilitaires. Celles-ci prennent toutes deux un paramètre supplémentaire indiquant la valeur courante du registre ESP : StackPointer.

type
  PCDeclCallInfo = ^TCDeclCallInfo;
  TCDeclCallInfo = packed record
    Previous: PCDeclCallInfo; /// Pointeur vers le contexte précédent
    StackPointer: Pointer;    /// Valeur de ESP au moment de l'appel
    ReturnAddress: Pointer;   /// Adresse de retour de l'appel
  end;

threadvar
  /// Liste des infos sur les appels cdecl (spécifique à chaque thread)
  CDeclCallInfoList : PCDeclCallInfo;

function GetLastValidCDeclCallInfo(StackPointer: Pointer;
  AllowSame: Boolean): PCDeclCallInfo;
var
  Previous: PCDeclCallInfo;
begin
  Result := CDeclCallInfoList;
  while (Result <> nil) and
    (Cardinal(Result.StackPointer) <= Cardinal(StackPointer)) do
  begin
    if AllowSame and (Result.StackPointer = StackPointer) then
      Break;
    Previous := Result.Previous;
    Dispose(Result);
    Result := Previous;
  end;
end;

procedure StoreCDeclReturnAddress(
  StackPointer, ReturnAddress: Pointer); stdcall;
var
  LastInfo, CurInfo: PCDeclCallInfo;
begin
  LastInfo := GetLastValidCDeclCallInfo(StackPointer, False);

  New(CurInfo);
  CurInfo.Previous := LastInfo;
  CurInfo.StackPointer := StackPointer;
  CurInfo.ReturnAddress := ReturnAddress;
  CDeclCallInfoList := CurInfo;
end;

function GetCDeclReturnAddress(StackPointer: Pointer): Pointer; register;
var
  LastInfo: PCDeclCallInfo;
begin
  LastInfo := GetLastValidCDeclCallInfo(StackPointer, True);

  if (LastInfo = nil) or (LastInfo.StackPointer <> StackPointer) then
  begin
    // This is a very, very bad case: everything has gone wrong! Stop dead!
    CDeclCallInfoList := LastInfo;
    Assert(False);
    Halt(1);
  end;

  CDeclCallInfoList := LastInfo.Previous;
  Result := LastInfo.ReturnAddress;
  Dispose(LastInfo);
end;

Nous avons ajouté un paramètre aux deux routines de stockage et de récupération. Il faut donc légèrement (pas mal en fait) revoir le code assembleur. Il faut passer la bonne valeur de ESP à chacune de ces deux routines, et bien faire en sorte que la même valeur soit envoyée aux deux routines (pour un même appel de notre routine créée, cela s'entend).

PUSH    ESP
CALL    StoreCDeclReturnAddress
PUSH    CallBackObj
CALL    CallBackMethod
MOV     [ESP],EAX
MOV     EAX,ESP
PUSH    EDX
CALL    GetCDeclReturnAddress
POP     EDX
XCHG    EAX,[ESP]
RET

Mis à part le jeu de transfert de valeurs pour conserver EAX et EDX, tout en envoyant la bonne valeur de ESP, il n'y a rien de bien méchant dans ce code, comparé à ce que nous avons déjà pu voir avec register.

On commence à être habitué : identifier les OpCodes de chaque instruction, et les placer dans une zone de mémoire allouée sur le tas. Puisque cette fois-ci il y a plus de code immuable, il était intéressant d'utiliser un tableau de Byte constant pour initialiser ces parties.

function MakeProcOfCDeclMethod(const Method: TMethod): Pointer;

type
  PCDeclRedirector = ^TCDeclRedirector;
  TCDeclRedirector = packed record
    PushESP: Byte;
    CallStoreAddress: TJmpInstruction;
    PushObj: Byte;
    ObjAddress: Pointer;
    CallMethod: TJmpInstruction;
    MovESPEAX: array[0..2] of Byte;
    MovEAXESP: array[0..1] of Byte;
    PushEDX: Byte;
    CallGetAddress: TJmpInstruction;
    PopEDX: Byte;
    Xchg: array[0..2] of Byte;
    Ret: Byte;
  end;

const
  Code: array[0..SizeOf(TCDeclRedirector)-1] of Byte = (
    $54,                     // PUSH    ESP
    $E8, $FF, $FF, $FF, $FF, // CALL    StoreCDeclReturnAddress
    $68, $EE, $EE, $EE, $EE, // PUSH    CallBackObj
    $E8, $DD, $DD, $DD, $DD, // CALL    CallBackMethod
    $89, $04, $24,           // MOV     [ESP],EAX
    $8B, $C4,                // MOV     EAX,ESP
    $52,                     // PUSH    EDX
    $E8, $CC, $CC, $CC, $CC, // CALL    GetCDeclReturnAddress
    $5A,                     // POP     EDX
    $87, $04, $24,           // XCHG    EAX,[ESP]
    $C3                      // RET
  );

begin
  GetMem(Result, SizeOf(Code));
  Move(Code[0], Result^, SizeOf(Code));

  with PCDeclRedirector(Result)^ do
  begin
    MakeCall(CallStoreAddress, @StoreCDeclReturnAddress);
    ObjAddress := Method.Data;
    MakeCall(CallMethod, Method.Code);
    MakeCall(CallGetAddress, @GetCDeclReturnAddress);
  end;
end;

Nous avons omis de préciser jusqu'ici que cette solution est sujette à des fuites mémoire en cas d'exception. Si une nouvelle routine de ce style est rappelée après, pas de problème : la suppression des données corrompues libèrera les données. Mais si rien ne vient plus jusqu'à la fin du thread, on s'expose à des fuites.

Pour remédier un minimum à cela, ajoutons encore une petite routine toute simple :

procedure ClearCDeclCallInfo;
begin
  GetLastValidCDeclCallInfo(Pointer($FFFFFFFF), False);
  CDeclCallInfoList := nil;
end;

L'appel de cette routine en fin de thread va libérer toute la pile des contextes. Pour épargner la peine de l'appeler aux programmes monothread, on ajoute un appel à cette routine dans le code de finalisation de l'unité.

initialization
finalization
  ClearCDeclCallInfo;
end.

À présent, il faut que les conditions suivantes soient toutes remplies pour avoir des fuites mémoire :

• une exception est levée et non gérée dans une méthode ainsi appelée ;
• ET cela se passe dans un thread ;
• ET aucune autre méthode n'est appelée de la même façon d'ici la fin du thread ;
• ET le thread n'appelle pas ClearCDeclCallInfo d'ici la fin de son exécution.

J'estime cela assez acceptable. Si ce n'est pas votre cas, je serai ravi de découvrir votre solution au problème :-).