Delphi "Array of Cons" à "Varargs"

Un "tableau de const" est en fait un tableau de TVARRRC, qui est un type de variante spécial. Il n'est pas compatible avec Varargs, et vous devriez vraiment pouvoir appeler la fonction Varargs directement sans enveloppe autour de celle-ci.

L'emballage que vous essayez d'écrire est possible dans Free Pascal, car Pascal gratuit prend en charge 2 déclarations équivalentes pour les fonctions externes de Varargs:

http://www.freecuce.org/docs-html/ref/refsu68.html

donc au lieu de xxx

Vous devez écrire xxx

mise à jour: j'ai essayé le même tour à Delphi, mais cela ne fonctionne pas: xxx

Je suppose que le prototype de pushfstring code> est quelque peu comme suit: xxx pré>

si ce n'est pas le cas, et est à la place: P> xxx pré>

... Puis je devrais vous couvrir également. p>

in c, si vous devez transmettre un appel d'une fonction variable à une autre, vous devez utiliser VA_LIST code>, VA_Start code> et VA_END code> et appelez la version V code> de la fonction. Donc, si vous impliez la mise en œuvre printf code> vous-même, vous pouvez utiliser vsprintf code> pour formater la chaîne - vous ne pouvez pas appeler sprintf code> directement et transmettre le long de la Liste d'arguments variadiques. Vous devez utiliser va_list code> et amis. P>

C'est assez gênant de gérer VA_LIST code> de Delphi, et techniquement, cela ne devrait pas être fait - la mise en œuvre de va_list code> est spécifique au temps d'exécution du fournisseur C compilateur C. p>

Cependant, nous pouvons essayer. Supposons que nous ayons une petite classe - bien que je l'ai fait un record pour la facilité d'utilisation: p> xxx pré>

Utilisation de cet enregistrement, nous pouvons construire manuellement le cadre d'appel attendu pour divers appels C. La convention d'appel de C sur X86 est de passer des arguments de droite à gauche sur la pile, avec le nettoyage de l'appelant. Voici le squelette d'une routine d'appel générique C: p> xxx pré>

prise printf code> comme exemple: p>

function CallManually2(Code: Pointer; Fmt: AnsiString;
    const Args: array of const): Pointer;
var
  i: Integer;
  caller: TVarArgCaller;
begin
  for i := High(Args) downto Low(Args) do
  begin
    case Args[i].VType of
      vtInteger: caller.PushArg(Args[i].VInteger);
      vtPChar: caller.PushArg(Args[i].VPChar);
      vtExtended: caller.PushArg(Args[i].VExtended^);
      vtAnsiString: caller.PushArg(PAnsiChar(Args[i].VAnsiString));
      vtWideString: caller.PushArg(PWideChar(Args[i].VWideString));
      vtUnicodeString: caller.PushArg(PWideChar(Args[i].VUnicodeString));
    else
      raise Exception.Create('Unknown type'); // etc.
    end;
  end;
  caller.PushArgList;
  caller.PushArg(PAnsiChar(Fmt));
  Result := caller.Invoke(Code);
end;

function vprintf(fmt: PAnsiChar; va_list: Pointer): Integer; cdecl;
    external 'msvcrt.dll' name 'vprintf';

begin
  // the hard way, va_list
  CallManually2(@vprintf, 'test of printf %s %d %.4g'#10, 
      [PAnsiChar('hello'), 42, C]);
end.

Barry Kelly m'a inspiré à la recherche d'une solution sans remplacer la pile ... Voici la solution (peut également utiliser l'invoke à partir de l'unité RTTI, à la place RealCall_CDecl).

// This function is copied from PascalScript
function RealCall_CDecl(p: Pointer;
  StackData: Pointer;
  StackDataLen: Longint; // stack length are in 4 bytes. (so 1 = 4 bytes)
  ResultLength: Longint; ResEDX: Pointer): Longint; Stdcall; 
  // make sure all things are on stack
var
  r: Longint;
begin
  asm
    mov ecx, stackdatalen
    jecxz @@2
    mov eax, stackdata
    @@1:
    mov edx, [eax]
    push edx
    sub eax, 4
    dec ecx
    or ecx, ecx
    jnz @@1
    @@2:
    call p
    mov ecx, resultlength
    cmp ecx, 0
    je @@5
    cmp ecx, 1
    je @@3
    cmp ecx, 2
    je @@4
    mov r, eax
    jmp @@5
    @@3:
    xor ecx, ecx
    mov cl, al
    mov r, ecx
    jmp @@5
    @@4:
    xor ecx, ecx
    mov cx, ax
    mov r, ecx
    @@5:
    mov ecx, stackdatalen
    jecxz @@7
    @@6:
    pop eax
    dec ecx
    or ecx, ecx
    jnz @@6
    mov ecx, resedx
    jecxz @@7
    mov [ecx], edx
    @@7:
  end;
  Result := r;
end;

// personally created function :)
function CallManually3(Code: Pointer; const Args: array of const): Pointer;
var
  i: Integer;
  tmp: AnsiString;
  data: AnsiString;
begin
  for i := Low(Args) to High(Args) do
  begin
    case Args[i].VType of
      vtInteger, vtPChar, vtAnsiString, vtWideString, vtUnicodeString: begin
          tmp := #0#0#0#0;
          Pointer((@tmp[1])^) := TVarRec(Args[i]).VPointer;
      end;
      vtExtended: begin
          tmp := #0#0#0#0#0#0#0#0;
          Double((@tmp[1])^) := TVarRec(Args[i]).VExtended^;
      end;
      // fill as needed
    else
      raise Exception.Create('Unknown type');
    end;

    data := data + tmp;
  end;

  Result := pointer(RealCall_CDecl(Code, @data[Length(data) - 3], 
    Length(data) div 4, 4, nil));
end;

function printf(fmt: PAnsiChar): Integer; cdecl; varargs;
    external 'msvcrt.dll' name 'printf';

begin
  CallManually3(@printf, 
    [AnsiString('test of printf %s %d %.4g'#10), 
      PAnsiChar('hello'), 42, 4.123]);
end.