2010-02-21 3 views
8

Пожалуйста, помогите! Мне нужно это преобразование, чтобы написать оболочку для некоторых заголовков C для Delphi.Delphi "массив const" до "varargs"

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

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; 

Как я могу преобразовать "массив сопзЬ" до "списков параметров"?

Редактировать: function PushString фактически находится внутри записи (я привел упрощенный пример), и у меня нет прямого доступа к pushfstring. Прямой вызов исключается.

Редактировать 2: Я пишу единицы для библиотеки LUA для Delphi, и для меня это очень важно.

Определение и предоставление всех деталей дела - у меня есть эта функция в 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 я использую только TLuaState из dtxLua.pas (потому что LuaLibrary громоздко, dtxLua моя обертка), для многих полезных и интересных вещей ...

+0

Функция 'pushfstring', которую вы пытаетесь вызвать, является внешней функцией. Невозможно «не иметь прямого доступа» к нему, потому что вы можете сделать объявление для него в любом месте. Хотя я ценю ваше желание вызвать функцию varargs с неизвестным количеством параметров, на самом деле вам это не нужно, потому что вы * можете * напрямую вызывать 'pushfstring', где бы вы ни называли' PushString'. –

+0

@Rob - Я подозреваю, что у него есть указатель на функцию. –

+0

Что такое прототип C для 'pushfstring'? –

ответ

12

Я предполагаю, что прототип pushfstring несколько, как это:

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

Если ISN» t, и вместо этого:

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

... тогда я также должен был вас покрыть.

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

Это довольно неудобно для обработки C's 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. 

Calling версии 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, но это может быть слишком мало. При необходимости увеличивайте.

+0

Можно улучшить код, нажав «стек массива» на реальный стек перед командой вызова? – arthurprs

+0

Барри - Уважение. Это то, что мне нужно. – HNB

+0

@arthurprs - как я упоминал, я строю вещи в массиве, а затем помещаю его в стек, чтобы сделать вещи легкими, понятными и гибкими. Гораздо сложнее абстрагироваться от деталей управления стеком, когда вы используете реальный стек. Копирование в стек также может быть выполнено. Я оставляю это как упражнение для читателя ... :) –

2

«массив const "на самом деле представляет собой массив TVarRec, который является особым вариантом. Он несовместим с varargs, и вы действительно должны иметь возможность вызвать функцию varargs напрямую без обертки вокруг него.

+0

Функция PushString фактически находится внутри записи (я дал упрощенный пример), и у меня нет прямого доступа к pushfstring. Прямой вызов исключается. – HNB

4

Обертка вы пытаетесь писать можно в Free Pascal, так как Free Pascal поддерживает 2 объявления будут сброшены для переменной длины внешних функций:

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; 

Обновление: Я попробовал один и тот же трюк в 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; 
+0

Благодарим за эту информацию, приятно знать. – HNB

1

Барри Келли вдохновил меня искать решение без замены стека ... Вот решение (возможно, также может использовать Invoke из блока 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.
Смежные вопросы