德尔福 "array of const"至 "varargs"

Question

请帮忙!我需要这个转换来为 Delphi 的一些 C 头文件编写包装器。

举个例子:

function pushfstring(fmt: PAnsiChar): PAnsiChar; cdecl; varargs; external;

...

function PushString(fmt: AnsiString; const args: array of const): AnsiString;
begin
  Result := AnsiString(pushfstring(PAnsiString(fmt), args)); // it's incorrect :/
end;

如何将“const 数组”转换为“varargs”？

编辑:函数PushString实际上在记录内部(我给出了一个简化的示例)，并且我无法直接访问pushfstring。不包括直接调用。

编辑2:我为Delphi编写了LUA库的单元，这个案例对我来说非常重要。

指定并提供问题的所有细节 - 我在 C: 中有此函数

LUA_API const char *(lua_pushfstring) (lua_State *L, const char *fmt, ...);

在 Delphi 中我有这样的东西:

LuaLibrary.pas

{...}
interface
{...}
function lua_pushfstring(L: lua_State; fmt: PAnsiChar): PAnsiChar; cdecl; varargs;
implementation
{...}
function lua_pushfstring; external 'lua.dll'; // or from OMF *.obj file by $L

dtxLua.pas

uses LuaLibrary;
{...}
type
  TLuaState = packed record
  private
    FLuaState: lua_State;
  public
    class operator Implicit(A: TLuaState): lua_State; inline;
    class operator Implicit(A: lua_State): TLuaState; inline;
    {...}
    // btw. PushFString can't be inline function
    function PushFString(fmt: PAnsiChar; const args: array of const ): PAnsiChar; 
    //... and a lot of 'wrapper functions' for functions like a lua_pushfstring, 
    // where L: lua_State; is the first parameter
  end;
implementation
{...}
function TLuaState.PushFString(fmt: PAnsiChar; const args: array of const )
  : PAnsiChar;
begin
  Result := lua_pushfstring(FLuaState, fmt, args); // it's incorrect :/
end;

在像 Lua.pas 这样的其他单元中，我只使用 dtxLua.pas 中的 TLuaState(因为 LuaLibrary 很大，dtxLua 是我的包装器)，用于许多有用且很酷的东西...

Answer 1

我猜 pushfstring 的原型(prototype)有点像这样:

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 和 friend 。

从 Delphi 处理 C 的 va_list 非常尴尬，从技术上讲，这是不应该这样做的 - va_list 的实现特定于 C 编译器供应商的运行时。

但是，我们可以尝试。假设我们有一个小类(class) - 尽管我为了便于使用而将其记录下来:

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.

注释:

• 以上内容预计在 Windows 上使用 x86。根据我的实验，Microsoft C、bcc32 (Embarcadero C++) 和 gcc 都以相同的方式传递 va_list(指向堆栈上第一个可变参数的指针)，所以它应该适合您；但一旦 Windows 上的 x86 假设被打破，预计这也可能被打破。

• 堆栈被交换以简化其构造。这可以通过更多的工作来避免，但是传递 va_list 也会变得更加棘手，因为它需要指向参数，就像它们是在堆栈上传递的一样。因此，代码需要假设被调用例程使用了多少堆栈；此示例假设 8K，但这可能太小。必要时增加。