Calling an assembly language function causes "floating point stack check" exception - delphi

Executing following code:
function ABCD32(Value: Cardinal): Single; register;
asm
BSWAP EAX
end;
function HexToFloat(hexValue: string; fmt: THexFloatFormat): Single;
var
c: Cardinal;
Err: Integer;
begin
Result := NaN;
c := HexToCardinal(hexValue, Err); //DCBA format
if Err <> 0 then Exit();
case fmt of
hfABCD: Result := ABCD32(c); //Here, after return from ABCD32
hfBADC: Result := BADC32(c);
hfCDAB: Result := CDAB32(c);
hfDCBA: Result := DCBA32(c);
end;
end;
causes a run-time errror:
Project HexFloat.exe raised exception class $C0000092 with message 'floating point stack check at 0x004e9903'.
What is this and how to handle it?
Update
Here is the CPU window output:
HexFloat.dpr.162: hfABCD: Result := ABCD32(c);
004E98F8 8B45F0 mov eax,[ebp-$10]
004E98FB E894FFFFFF call ABCD32
004E9900 D95DF4 fstp dword ptr [ebp-$0c] //WTF?
004E9903 9B wait //Exception happens here
004E9904 EB28 jmp $004e992e

Your function does not respect the ABI. Floating point values should be returned in ST(0) on the x87 unit.
function ABCD32(Value: Cardinal): Single; register;
asm
BSWAP EAX
PUSH EAX
FLD [ESP]
ADD ESP,4
end;

Related

Delphi 5 compiler bug returning interface pointer rather than return value

I present you a bug in the Delphi 5 compiler. I know there's not going to be any fix for it; but a workaround would be super
program Project1;
uses
Dialogs, SysUtils;
{$R *.RES}
type
IFoo = interface
['{D68DA49A-F870-433D-9343-4964BFECFF27}']
procedure Grob(a: Integer; b: Integer);
end;
TFoo = class(TInterfacedObject, IFoo)
public
procedure Grob(a: Integer; b: Integer); virtual;
end;
procedure TFoo.Grob(a: Integer; b: Integer);
begin
end;
function DoStuff(): Integer;
var
foo: IFoo;
begin
foo := TFoo.Create;
try
Result := 1;
Exit;
finally
foo.Grob(0, 0);
end;
Result := 2;
end;
var
n: Integer;
begin
n := DoStuff;
if n <> 0 then
ShowMessage('Failed: '+IntToStr(n))
else
ShowMessage('Passed: '+IntToStr(n));
end.
The real guts is the function DoStuff which should return one:
function DoStuff(): Integer;
var
foo: IFoo;
begin
foo := TFoo.Create;
try
Result := 1;
Exit;
finally
foo.Grob(0, 0);
end;
Result := 2;
end;
The function should return one. Instead it returns the address of the interfaced object:
The assembly
The code actually does start to set the result to one:
Project1.dpr.30: Result := 1;
mov ebx,$00000001 ; place return value 1 in EBX
Project1.dpr.31: Exit;
call #TryFinallyExit ; call the finally block
jmp DoStuff + $6E
and as the function is about to return, it does copy EBX into EAX in order to return it:
mov eax,ebx ;EBX into EAX for return
But finally block (calling the interfaced method) is the problem. It blows away the return value stored in EBX:
We arrive here from the call #TryFinallyExit
Project1.dpr.33: foo.Grob(0, 0);
xor ecx,ecx
xor edx,edx
mov eax,[ebp-$04]
mov ebx,[eax] <----- overwriting ebx with interface address
call dword ptr [ebx+$0c]
ret
After the "call" to the finally block, it returns to a jump, which sends it to:
Project1.dpr.36: Result := 2;
...
xor eax,eax
pop edx
pop ecx
pop ecx
mov fs:[eax],edx
push $00442e1f
lea eax,[ebp-$04]
call #IntfClear
ret
...
mov eax,ebx <----- places overwritten EBX into EAX for return
Project1.dpr.37: end;
pop ebx
pop ecx
pop ebp
ret
The return value rather than being one, or two, is the address of the interface pointer.
I know none of you have Delphi 5. And even if you did,
"What would you like me to say?"
I know the difficulty. What i actually need is some sort of workaround.
As you observed, the compiler is storing the result into EBX, but then overwriting it before it subsequently copies EBX into EAX to return the result to the caller.
The compiler should be doing one of the following:
Using a different register to store the result value temporarily, so that its use of EBX does not destroy the result value, or
Not using EBX in the call to Grob, or
Storing the result value in something more persistent than a register, like on the stack.
Obviously options 1 and 2 are not readily available to you, but the latter is the workaround that you need to implement in this example – use a local variable to hold your intended Result value until you are ready to return it:
function DoStuff(): Integer;
var
foo: IFoo;
MyResult: Integer;
begin
foo := TFoo.Create;
try
try
MyResult := 1;
Exit;
finally
foo.Grob(0, 0);
end;
MyResult := 2;
finally
Result := MyResult;
end;
end;

Delphi 7 - Not Enough Actual Parameters

I'm so new to Delphi 7, also in this forum and I've questions.
I have successfully converted an url string to hex using Jorlen Young's function StrToHex - Advanced Encryption Standard (AES) Interface Unit v1.3!.
But, when I implement his function EncryptString, then I got error at the very bottom of my code: Encrypt := EncryptString('www.website.com'); with the following messsage:
[Hint] Unit1.pas(xx): Variable 'st' is declared but never used in 'EncryptString'
[Error] Unit1.pas(xx): Not enough actual parameters
[Fatal Error] Project1.dpr(5): Could not compile used unit 'Unit1.pas'
Could you give me some tips in how to implement the "Key" and "KeyBit" option into my syntax: Encrypt := EncryptString('www.website.com'); ?
I would appreciate any help.
...here is my code :
.....................
.....................
type
TKeyBit = (kb128, kb192, kb256);
.....................
.....................
procedure IdMappedPortTCP1Execute(AThread: TIdMappedPortThread);
private
{ Private declarations }
public
{ Public declarations }
end;
implementation
function StrToHex(Const str: Ansistring): Ansistring;
asm
push ebx
push esi
push edi
test eax,eax
jz ##Exit
mov esi,edx
mov edi,eax
mov edx,[eax-4]
test edx,edx
je ##Exit {Length(S) = 0}
mov ecx,edx
Push ecx
shl edx,1
mov eax,esi
{$IFDEF VER210}
movzx ecx, word ptr [edi-12]
{$ENDIF}
call System.#LStrSetLength
mov eax,esi
Call UniqueString
Pop ecx
##SetHex:
xor edx,edx
mov dl, [edi]
mov ebx,edx
shr edx,4
mov dl,byte ptr[edx+##HexChar]
mov [eax],dl
and ebx,$0F
mov dl,byte ptr[ebx+##HexChar]
inc eax
mov [eax],dl
inc edi
inc eax
loop ##SetHex
##Exit:
pop edi
pop esi
pop ebx
ret
##HexChar: db '0123456789ABCDEF'
end;
function EncryptString(Value: AnsiString; Key: AnsiString; KeyBit: TKeyBit = kb128): AnsiString;
var
{$IFDEF VER210}
SS,DS: TMemoryStream;
{$ELSE}
SS, DS: TStringStream;
{$ENDIF}
Size: Int64;
AESKey128: TAESKey128;
AESKey192: TAESKey192;
AESKey256: TAESKey256;
st: AnsiString;
begin
Result := '';
{$IFDEF VER210}
ss := TMemoryStream.Create;
SS.WriteBuffer(PAnsiChar(Value)^,Length(Value));
DS := TMemoryStream.Create;
{$ELSE}
SS := TStringStream.Create(Value);
DS := TStringStream.Create('');
{$ENDIF}
try
Size := SS.Size;
DS.WriteBuffer(Size, SizeOf(Size));
if KeyBit = kb128 then
begin
FillChar(AESKey128, SizeOf(AESKey128), 0 );
Move(PAnsiChar(Key)^, AESKey128, Min(SizeOf(AESKey128), Length(Key)));
EncryptAESStreamECB(SS, 0, AESKey128, DS);
end;
if KeyBit = kb192 then
begin
FillChar(AESKey192, SizeOf(AESKey192), 0 );
Move(PAnsiChar(Key)^, AESKey192, Min(SizeOf(AESKey192), Length(Key)));
EncryptAESStreamECB(SS, 0, AESKey192, DS);
end;
if KeyBit = kb256 then
begin
FillChar(AESKey256, SizeOf(AESKey256), 0 );
Move(PAnsiChar(Key)^, AESKey256, Min(SizeOf(AESKey256), Length(Key)));
EncryptAESStreamECB(SS, 0, AESKey256, DS);
end;
{$IFDEF VER210}
SetLength(st,Ds.Size);
DS.Position := 0;
DS.ReadBuffer(PAnsiChar(st)^,DS.Size);
Result := StrToHex(st);
{$ELSE}
Result := StrToHex(DS.DataString);
{$ENDIF}
finally
SS.Free;
DS.Free;
end;
end;
procedure TForm1.IdMappedPortTCP1Execute(AThread: TIdMappedPortThread);
var Payload, Encrypt:String;
begin
Encrypt := EncryptString('www.website.com');
if Pos('CONNECT',AThread.NetData)<>0 then
begin
if host.Text = 'Operator' then
begin
Athread.OutboundClient.Write(Athread.NetData+#13#10);
Payload := 'GET http://'+Encrypt+'/ HTTP/1.1'+#13#10;
Athread.NetData:= Athread.NetData+Payload;
end;
end;
end.
Cheers,
RzV
EncryptString has 2 required and one optional parameter. You need at least to provide the key.

Delphi inline assembler and class properties

I am trying to rewrite the TList.IndexOf method in assembler (XE3). Here is my code
function TFastList.IndexOfAsm(Item: Pointer): Integer;
{var
P: PPointer;
begin
P := Pointer(FList);
for Result := 0 to FCount - 1 do
begin
if P^ = Item then
Exit;
Inc(P);
end;
Result := -1;}
var
FCnt, rslt: Integer;
FData: Pointer;
begin
FCnt := Count;
FData := List;
asm
push edi
mov ecx, FCnt
mov edi, FData
mov eax, Item
repne scasd
mov eax, FCnt
sub eax, ecx
dec eax
mov rslt, eax
pop edi
end;
Result := rslt;
end;
Naturally I would like to use the properties like Count or List directly. I understand why the compiler refuses to give access to private fields FCount and FList, but how do I access the corresponding properties? Count, Self.Count, and [eax].Count all give the inline assembler error.
JIC: I don't handle the not found situation here by intent
You can't access the object property via Delphi assembler!
Delphi compiler is good and Delphi compiled code I belive is also very fast.
Your code has mistake because doesn't test zero count velue what should cause memory access violation!
Do not use repne scasd because it is slow.
However you can hack code manualy to make test... :)
function TFastList.IndexOfAsm(Item: Pointer): Integer;
//eax = self
//edx = Item
{var
P: PPointer;
begin
P := Pointer(FList);
for Result := 0 to FCount - 1 do
begin
if P^ = Item then
Exit;
Inc(P);
end;
Result := -1;}
const
FItems = 4; //data offset of FItems
FCount = 8; //data offset of FCount
asm
mov ecx, [eax].FItems //ecx = #FItems
mov eax, [eax].FCount //eax = FCount
dec eax //test zero count!
js #Exit //if count was 0 then exit as -1
#Loop: //repeat
cmp Item, [ecx + eax * 4]
jz #Exit
dec eax
jns #Loop //until eax < 0 (actually -1)
#Exit:
end;

Delphi inline assembler pointer to structure

Hi people is there a way i can access a pointer to a structure member directly from in line assembler i tried this
procedure test(eu:PImageDosHeader);assembler;
asm
push eu._lfanew
end;
It won't compile but if i use this
procedure test(eu:Pointer);
var
xx:TImageDosHeader;
begin
xx:=TImageDosHeader(eu^);
asm
push xx._lfanew
end;
end;
It works great.Any idea how can i access a structure trough a pointer in inline asm? is a matter of optimizing the code
Yet another workaround:
procedure test(eu:PImageDosHeader);
asm
push eu.TImageDosHeader._lfanew
end;
The following works:
type
PMyStruct = ^TMyStruct;
TMyStruct = record
A, B: cardinal;
end;
procedure ShowCard(Card: cardinal);
begin
ShowMessage(IntToHex(Card, 8));
end;
procedure test(Struct: PMyStruct);
asm
push ebx // We must not alter ebx
mov ebx, eax // eax is Struct; save in ebx
mov eax, TMyStruct(ebx).A
call ShowCard
mov eax, TMyStruct(ebx).B
call ShowCard
pop ebx // Restore ebx
end;
procedure TForm6.FormCreate(Sender: TObject);
var
MyStruct: TMyStruct;
begin
MyStruct.A := $22222222;
MyStruct.B := $44444444;
test(#MyStruct);
end;
I would write it like this:
procedure test(const eu: TImageDosHeader);
asm
push TImageDosHeader([EAX])._lfanew
end;
The pertinent documentation is here.

Convert a call method Cdecl convention to a call method pascal convention

I'm trying to develop some code to make generic calls to methods by it's name.
For example, some one from web send me a text as 'TTest.MethodTest.Param1.Param2', and I find the class and call it method by it's name with the parameters.
Ok, I did this, I got some code from Andreas Hausladen did little adjusts to work where I need. But, the implementation of ExecuteAsyncCall, was create to cdecl functions I need to change it's code to work with pascal convention methods.
Here is the code sample, if some one would like to test.
Some one can help me ? I'm studying to solve this but it's complicated to me.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
published
{ Public declarations }
procedure Test(AString: string; AInteger: Integer); cdecl;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function CopyVarRec(const Data: TVarRec): TVarRec;
begin
if (Data.VPointer <> nil) and
(Data.VType in [vtString, vtAnsiString, vtWideString,
{$IFDEF UNICODE}vtUnicodeString,{$ENDIF} vtExtended,
vtCurrency, vtInt64, vtVariant, vtInterface]) then
begin
Result.VType := Data.VType;
Result.VPointer := nil;
{ Copy and redirect TVarRec data to prevent conflicts with other threads,
especially the calling thread. Otherwise reference counted types could
be freed while this asynchron function is still executed. }
case Result.VType of
vtAnsiString: AnsiString(Result.VAnsiString) := AnsiString(Data.VAnsiString);
vtWideString: WideString(Result.VWideString) := WideString(Data.VWideString);
{$IFDEF UNICODE}
vtUnicodeString: UnicodeString(Result.VUnicodeString) := UnicodeString(data.VUnicodeString);
{$ENDIF UNICODE}
vtInterface : IInterface(Result.VInterface) := IInterface(Data.VInterface);
vtString : begin New(Result.VString); Result.VString^ := Data.VString^; end;
vtExtended : begin New(Result.VExtended); Result.VExtended^ := Data.VExtended^; end;
vtCurrency : begin New(Result.VCurrency); Result.VCurrency^ := Data.VCurrency^; end;
vtInt64 : begin New(Result.VInt64); Result.VInt64^ := Data.VInt64^; end;
vtVariant : begin New(Result.VVariant); Result.VVariant^ := Data.VVariant^; end;
end;
end
else
Result := Data;
end;
function ExecuteAsyncCall(AProc: Pointer; MethodData: TObject; const AArgs: array of const): Integer;
var
I: Integer;
V: ^TVarRec;
ByteCount: Integer;
FArgs: array of TVarRec;
FProc: function: Integer register;
begin
FProc := AProc;
SetLength(FArgs, 1 + Length(AArgs));
// insert "Self"
FArgs[0].VType := vtObject;
FArgs[0].VObject := MethodData;
for I := 0 to High(AArgs) do
FArgs[I + 1] := CopyVarRec(AArgs[I]);
ByteCount := Length(FArgs) * SizeOf(Integer) + $40;
{ Create a zero filled buffer for functions that want more arguments than
specified. }
asm
xor eax, eax
mov ecx, $40 / 8
##FillBuf:
push eax
push eax
// push eax
dec ecx
jnz ##FillBuf
end;
for I := High(FArgs) downto 0 do // cdecl => right to left
begin
V := #FArgs[I];
case V.VType of
vtInteger: // [const] Arg: Integer
asm
mov eax, V
push [eax].TVarRec.VInteger
end;
vtBoolean, // [const] Arg: Boolean
vtChar: // [const] Arg: AnsiChar
asm
mov eax, V
xor edx, edx
mov dl, [eax].TVarRec.VBoolean
push edx
end;
vtWideChar: // [const] Arg: WideChar
asm
mov eax, V
xor edx, edx
mov dx, [eax].TVarRec.VWideChar
push edx
end;
vtExtended: // [const] Arg: Extended
asm
add [ByteCount], 8 // two additional DWORDs
mov eax, V
mov edx, [eax].TVarRec.VExtended
movzx eax, WORD PTR [edx + 8]
push eax
push DWORD PTR [edx + 4]
push DWORD PTR [edx]
end;
vtCurrency, // [const] Arg: Currency
vtInt64: // [const] Arg: Int64
asm
add [ByteCount], 4 // an additional DWORD
mov eax, V
mov edx, [eax].TVarRec.VCurrency
push DWORD PTR [edx + 4]
push DWORD PTR [edx]
end;
vtString, // [const] Arg: ShortString
vtPointer, // [const] Arg: Pointer
vtPChar, // [const] Arg: PChar
vtObject, // [const] Arg: TObject
vtClass, // [const] Arg: TClass
vtAnsiString, // [const] Arg: AnsiString
{$IFDEF UNICODE}
vtUnicodeString, // [const] Arg: UnicodeString
{$ENDIF UNICODE}
vtPWideChar, // [const] Arg: PWideChar
vtVariant, // const Arg: Variant
vtInterface, // [const]: IInterface
vtWideString: // [const] Arg: WideString
asm
mov eax, V
push [eax].TVarRec.VPointer
end;
end;
end;
Result := FProc;
asm // cdecl => we must clean up
add esp, [ByteCount]
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ExecuteAsyncCall(Self.MethodAddress('Test'), Self, ['Test ', 1])
end;
procedure TForm1.Test(AString: string; AInteger: Integer);
begin
ShowMessage(AString + IntToStr(AInteger));
end;
end.
Att.
Obs: I'm working on Delphi 2007
The pascal calling convention passes parameters from left to right, whereas cdecl passes them right to left. To account for that difference, simply reverse the order that the parameters get pushed onto the stack:
for I := High(FArgs) downto 0 do // cdecl => right to left
for I := 0 to High(FArgs) do // pascal => left to right
Next, the Self parameter of a method gets passed last instead of first in the pascal convention. The net effect is that in both conventions, Self is the last parameter pushed onto the stack. You can add it to the end of your FArgs array, but if this were my code, I'd just push it manually after the main argument loop (which would also allow omitting the second argument array entirely):
asm
push [MethodData]
end;
Finally, in the pascal convention, the receiver cleans up the stack, whereas in cdecl, the caller cleans it up. Remove this code:
asm // cdecl => we must clean up
add esp, [ByteCount]
end;
// pascal => do nothing
The code also makes an allowance for calling functions with fewer parameters than the target function expects. It allocates a 40-byte buffer and fills it with zeros. That won't work with a pascal function, though. A pascal function always pops the same number of parameters from the stack, so if you provide the wrong number of parameters when you call it, you'll end up trashing the stack when the function returns. Remove the assembler block below the comment:
{ Create a zero filled buffer for functions that want more arguments than
specified. }
asm
...
end;
There's nothing you can do to check whether you've received the correct number of parameters. All you can do is make sure the stack pointer upon return from the function is the same as it was before you started pushing parameters.
I agree but I think that Self have to be pushed last:
http://docwiki.embarcadero.com/RADStudio/en/Program_Control
// insert "Self"
for I := 0 to High(AArgs) do
FArgs[I] := CopyVarRec(AArgs[I]);
FArgs[High(AArgs)+1].VType := vtObject;
FArgs[High(AArgs)+1].VObject := MethodData;
But I don't believe this code can be used and it'll crash:
1) all parameters of all methods must be variants
2) wrong number of parameters
3) wrong type (or order) of parameters
I think you have to find other solution.

Resources