Delphi "array of const" to "varargs"

Question

Please help! I need this conversion to write wrapper for some C headers for Delphi.

As an example:

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;

How can I convert "array of const" to "varargs"?

edit: function PushString is actually inside the record (I gave a simplified example), and I do not have direct access to pushfstring. Direct call is excluded.

edit 2:I write the units for LUA library for Delphi and the case is quite important for me.

Specifying and providing all the details of the matter - I have this function in C:

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

In Delphi I have something like this:

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;

and in other units like Lua.pas i use only TLuaState from dtxLua.pas (because LuaLibrary is bulky, dtxLua is my wrapper), for many useful and cool things...

Answer 1

I'm guessing that the prototype for pushfstring is somewhat like this:

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

If it isn't, and is instead:

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

... then I should have you covered also.

In C, if you have to pass on a call from one variadic function to another, you should use va_list, va_start and va_end, and call the v version of the function. So, if you were implementing printf yourself, you might use vsprintf to format the string - you can't call sprintf directly and pass along the variadic argument list. You need to use va_list and friends.

It's pretty awkward to handle C's va_list from Delphi, and technically it shouldn't be done - the implementation of va_list is specific to the C compiler vendor's runtime.

However, we can try. Suppose we have a little class - though I made it a record for ease of use:

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;

Using this record, we can manually construct the call frame expected for various C calls. C's calling convention on x86 is to pass arguments from right to left on the stack, with the caller cleaning up. Here's the skeleton of a generic C calling routine:

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;

Taking printf as an example:

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.

Calling the va_list version is slightly more involved, as the va_list argument's location needs to be placed carefully where it is expected:

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.

Notes:

• The above expects x86 on Windows. Microsoft C, bcc32 (Embarcadero C++) and gcc all pass va_list in the same way (a pointer to the first variadic argument on the stack), according to my experiments, so it should work for you; but as soon as the x86 on Windows assumption is broken, expect this to possibly break too.

• The stack is swapped to ease with its construction. This can be avoided with more work, but passing va_list also becomes trickier, as it needs to point at the arguments as if they were passed on the stack. As a consequence, the code needs to make an assumption about how much stack the called routine uses; this example assumes 8K, but this may be too small. Increase if necessary.