Delphi “массив константы” к “varargs”

Я предполагаю, что прототип для pushfstring выглядит примерно так:

void pushfstring(const char *fmt, va_list args);

Если это не так, а вместо этого:

void pushfstring(const char *fmt, ...);

... тогда я должен вас охватить.

В C, если вам нужно передать вызов от одной вариативной функции к другой, вы должны использовать va_list , va_start и va_end и вызвать версия функции v . Итак, если вы сами реализовали printf , вы можете использовать vsprintf для форматирования строки - вы не можете напрямую вызвать sprintf и передать список вариативных аргументов . Вам нужно использовать va_list и друзей.

Довольно неудобно обрабатывать C va_list из Delphi, и технически этого делать не следует - реализация va_list специфична для среды исполнения поставщика компилятора C.

Однако мы можем попробовать. Предположим, у нас есть небольшой класс - хотя я сделал его записью для простоты использования:

type
  TVarArgCaller = record
  private
    FStack: array of Byte;
    FTop: PByte;
    procedure LazyInit;
    procedure PushData(Loc: Pointer; Size: Integer);
  public
    procedure PushArg(Value: Pointer); overload;
    procedure PushArg(Value: Integer); overload;
    procedure PushArg(Value: Double); overload;
    procedure PushArgList;
    function Invoke(CodeAddress: Pointer): Pointer;
  end;

procedure TVarArgCaller.LazyInit;
begin
  if FStack = nil then
  begin
    // Warning: assuming that the target of our call doesn't 
    // use more than 8K stack
    SetLength(FStack, 8192);
    FTop := @FStack[Length(FStack)];
  end;
end;

procedure TVarArgCaller.PushData(Loc: Pointer; Size: Integer);
  function AlignUp(Value: Integer): Integer;
  begin
    Result := (Value + 3) and not 3;
  end;
begin
  LazyInit;
  // actually you want more headroom than this
  Assert(FTop - Size >= PByte(@FStack[0]));
  Dec(FTop, AlignUp(Size));
  FillChar(FTop^, AlignUp(Size), 0);
  Move(Loc^, FTop^, Size);
end;

procedure TVarArgCaller.PushArg(Value: Pointer); 
begin
  PushData(@Value, SizeOf(Value));
end;

procedure TVarArgCaller.PushArg(Value: Integer); 
begin
  PushData(@Value, SizeOf(Value));
end;

procedure TVarArgCaller.PushArg(Value: Double); 
begin
  PushData(@Value, SizeOf(Value));
end;

procedure TVarArgCaller.PushArgList;
var
  currTop: PByte;
begin
  currTop := FTop;
  PushArg(currTop);
end;

function TVarArgCaller.Invoke(CodeAddress: Pointer): Pointer;
asm
  PUSH EBP
  MOV EBP,ESP

  // Going to do something unpleasant now - swap stack out
  MOV ESP, EAX.TVarArgCaller.FTop
  CALL CodeAddress
  // return value is in EAX
  MOV ESP,EBP

  POP EBP
end;

Используя эту запись, мы можем вручную создать кадр вызова, ожидаемый для различных вызовов C. Соглашение о вызовах C на x86 заключается в передаче аргументов в стеке справа налево, при этом вызывающая сторона очищается. Вот скелет стандартной процедуры вызова C:

function CallManually(Code: Pointer; 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));
      // fill as needed
    else
      raise Exception.Create('Unknown type');
    end;
  end;
  Result := caller.Invoke(Code);
end;

В качестве примера printf :

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

const
  // necessary as 4.123 is Extended, and %g expects Double
  C: Double = 4.123;
begin
  // the old-fashioned way
  printf('test of printf %s %d %.4g'#10, PAnsiChar('hello'), 42, C);
  // the hard way
  CallManually(@printf, [AnsiString('test of printf %s %d %.4g'#10), 
                         PAnsiChar('hello'), 42, C]);
end.

Вызов версии va_list немного сложнее, так как va_list расположение аргумента необходимо аккуратно разместить там, где оно ожидается:

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.

Примечания:

• Вышеупомянутое предполагает x86 в Windows.Согласно моим экспериментам, Microsoft C, bcc32 (Embarcadero C ++) и gcc передают va_list одинаковым образом (указатель на первый вариативный аргумент в стеке), так что это должно работать для вас; но как только предположение о x86 в Windows будет нарушено, можно ожидать, что это тоже сломается.

• Стек меняют местами, чтобы упростить его сборку. Этого можно избежать, приложив больше усилий, но передача va_list также становится более сложной, поскольку необходимо указывать на аргументы, как если бы они были переданы в стек. Как следствие, код должен сделать предположение о том, сколько стека использует вызываемая подпрограмма; в этом примере предполагается 8K, но это может быть слишком мало. При необходимости увеличьте.