Delphi "массив const" в " varargs"
пожалуйста, помогите! Мне нужно это преобразование, чтобы написать обертку для некоторых заголовков C для Delphi.
пример:
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. Прямой вызов исключен.
edit 2: я пишу единицы для библиотеки LUA для Delphi и случая для меня это очень важно.
указание и предоставление всех деталей вопроса-у меня есть эта функция в C:
LUA_API const char *(lua_pushfstring) (lua_State *L, const char *fmt, ...);
в Делфи у меня есть что-то вроде этого:
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 я использую только TLuaState из dtxLua.pas (потому что LuaLibrary громоздкий, dtxLua-моя обертка), для многих полезных и интересных вещей...
4 ответов
я предполагаю, что прототип для 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
напрямую и передайте список аргументов variadic. Вам нужно использовать va_list
и друзей.
это довольно неудобно с 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, но это может быть слишком мало. Увеличить при необходимости.
оболочка, которую вы пытаетесь написать, возможна в Free Pascal, так как Free Pascal поддерживает 2 равнозначных объявления для внешних функций varargs:
http://www.freepascal.org/docs-html/ref/refsu68.html
таким образом, вместо
function pushfstring(fmt: PAnsiChar): PAnsiChar; cdecl; varargs; external;
вы должны написать
function pushfstring(fmt: PAnsiChar; Args: Array of const): PAnsiChar; cdecl; external;
Update: я пробовал тот же трюк в Delphi, но он не работает:
//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;
"массив const" на самом деле является массивом TVarRec, который является специальным типом варианта. Он несовместим с varargs, и вы действительно должны иметь возможность вызывать функцию varargs напрямую без оболочки вокруг нее.
Бэрри Келли вдохновил меня на поиск решения без замены стека... Вот решение (возможно, также можно использовать вызов из блока rtti вместо 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.