views:

855

answers:

4

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...

+1  A: 

An "array of const" is actually an array of TVarRec, which is a special variant type. It's not compatible with varargs, and you really should be able to call the varargs function directly without a wrapper around it.

Mason Wheeler
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.
HNB
+1  A: 

The wrapper you are trying to write is possible in Free Pascal, since Free Pascal supports 2 equvalent declarations for varargs external functions:

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

so instead of

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

you should write

function pushfstring(fmt: PAnsiChar; Args: Array of const): PAnsiChar; cdecl; external;

Update: I have tried the same trick in Delphi, but it does not work:

//function sprintf(S, fmt: PAnsiChar; const args: array of const): Integer;
//           cdecl; external 'MSVCRT.DLL';

function sprintf(S, fmt: PAnsiChar): Integer;
           cdecl; varargs; external 'MSVCRT.DLL';

procedure TForm1.Button1Click(Sender: TObject);
var
  S, fmt: Ansistring;

begin
  SetLength(S, 99);
  fmt:= '%d - %d';
//  sprintf(PAnsiChar(S), PAnsiChar(fmt), [1, 2]);
  sprintf(PAnsiChar(S), PAnsiChar(fmt), 1, 2);
  ShowMessage(S);
end;
Serg
Thanks for this informations, nice to know.
HNB
+6  A: 

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.

Barry Kelly
It's possible to to improve the code by pushing the "array stack" to the real stack before the call instruction?
arthurprs
Barry - Respect. That is what I needed.
HNB
@arthurprs - as I mention, I construct things in the array and then place it in as the stack to make things easy, understandable and flexible. It's much harder to abstract away details of stack management when you're using the real stack. Copying in the stack could also be done. I leave it as an exercise for the reader... :)
Barry Kelly
A: 

Barry Kelly inspired me to seeking a solution without replacing the stack... Here is the solution (probably could also use the Invoke from the rtti unit, instead 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.
HNB