I have a library that uses assembler code for some functions and I would like to compile it on x64, of course throwing erros. Could anyone be so kind as to correct it (and maybe even explain me WHY these functions are written in ASM)?
function Trunc(const x : Single) : Integer; register;
const cwChop : Word = $1F3F;
asm
SUB ESP,8
FSTCW [ESP]
FLDCW cwChop
FLD x
FISTP dword ptr [ESP+4]
FLDCW [ESP]
POP ECX
POP EAX
end;
function Frac(const x : Single) : Single; register;
begin
Result := x - Trunc(x);
end;
function Round(const x : Single) : Integer; register;
asm
SUB ESP,4
FLD x
FISTP dword ptr [ESP]
POP EAX
end;
most humble thanks!
Related
// VMware detection as described by Elias Bachaalany
function IsInsideVMware: Boolean;
begin
Result := True;
try
asm
push edx;
push ecx;
push ebx;
mov eax, 'VMXh';
mov ebx, 0;
mov ecx, 10;
mov edx, 'VX';
in eax, dx;
cmp ebx, 'VMXh';
setz [Result];
pop ebx;
pop ecx;
pop edx;
end;
except
Result := False;
end;
end;
function IsRunningUnderHyperV: BOOL; stdcall;
var
VMBranding: array[0..12] of AnsiChar;
begin
asm
mov eax, $40000000;
cpuid;
mov dword ptr [VMBranding+0], ebx; // Get the VM branding string
mov dword ptr [VMBranding+4], ecx;
mov dword ptr [VMBranding+8], edx;
end;
VMBranding[12] := #0;
Result := CompareText(String(VMBranding), 'Microsoft Hv') = 0;
end;
How can this be done for 64-bit Delphi application?
If I try to compile it as 64-bit I get message "Unsupported language feature: ASM" and "Operand size mismatch". I know that you need to separate asm code from pascal code and registers are different but have no idea how to do it?
At end, I have used this solution for 32/64-bit.
var
LFlag: Cardinal;
//================================= VMWare =====================================
procedure TryVMWare;
{$IFDEF CPUX86}
asm
push eax
push ebx
push ecx
push edx
mov eax, 'VMXh'
mov ecx, 0Ah
mov dx, 'VX'
in eax, dx
mov LFlag, ebx
pop edx
pop ecx
pop ebx
pop eax
end;
{$ENDIF CPUX86}
{$IFDEF CPUX64}
asm
push rax
push rbx
push rcx
push rdx
mov eax, 'VMXh'
mov ecx, 0Ah
mov dx, 'VX'
in eax, dx
mov LFlag, ebx
pop rdx
pop rcx
pop rbx
pop rax
end;
{$ENDIF CPUX64}
function IsInsideVMware: Boolean;
begin
LFlag := 0;
try
TryVMWare;
except
end;
Result := LFlag = $564D5868;
end;
As for detecting other VM brands in 64-bit I have used code from:
https://github.com/JBontes/FastCode/blob/master/FastcodeCPUID.pas
Code is updated to run and compile as x64 bit and detect virtual machines brands.
The JEDI JclSysInfo.GetCpuInfo() function gets just about everything you'd ever want to know about the CPU, and returns the physical device's characteristics regardless of whether you're in a VM or on the root OS. The easiest way to detect most VMs is to get the CPUID string:
function GetVMBranding: String;
var
VMBranding: array[0..12] of AnsiChar;
begin
asm
mov eax, $40000000;
cpuid;
mov dword ptr [VMBranding+0], ebx; // Get the VM branding string
mov dword ptr [VMBranding+4], ecx;
mov dword ptr [VMBranding+8], edx;
end;
VMBranding[12] := #0;
Result := String(VMBranding);
end;
Then compare it to known strings (a list can be found at https://en.wikipedia.org/wiki/CPUID#:~:text=In%20the%20x86%20architecture%2C%20the,and%20SL%2Denhanced%20486%20processors) However, there are a couple of important caveats:
The CPUID query will return the Hyper-V signature if Hyper-V is installed, whether or not you're running on the root OS or in a VM. This is because once Hyper-V is installed, its hypervisor is managing threads even for the root OS. I have not found a way yet to detect actually running inside a Hyper-V VM.
VirtualBox and WINE require separate methods of detection. WINE adds some functions to NTDLL.DLL, so looking for those functions is a reliable way to detect WINE. For VirtualBox, you have to look for its service in the list of running processes.
function CheckWine: Boolean;
var
hnd: THandle;
wine_get_version: function : pchar; {$IFDEF Win32} stdcall; {$ENDIF}
wine_unix2fn: procedure (p1:pointer; p2:pointer); {$IFDEF Win32} stdcall; {$ENDIF}
begin
Result := False;
hnd := LoadLibrary('ntdll.dll');
if hnd > 32 then begin
wine_get_version := GetProcAddress(hnd, 'wine_get_version');
wine_unix2fn := GetProcAddress(hnd, 'wine_nt_to_unix_file_name');
if assigned(wine_get_version) or assigned(wine_unix2fn) then
Result := True;
FreeLibrary(hnd);
end;
end;
//uses WinApi.TlHelp32
function CheckVirtualBox: Boolean;
var
handle: THandle;
procinfo: ProcessEntry32;
begin
Result := False;
handle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
procinfo.dwSize := sizeof(PROCESSENTRY32);
while(Process32Next(handle, procinfo)) do begin
if (POS('VBoxService.exe', procinfo.szExeFile) > 0) then begin
Result := True;
Break;
end;
end;
CloseHandle(handle);
end;
I use this functions since D2007 I got it online, don't remember where.
But now in XE7 it return a compilation error:
"E2107 Operand size mismatch"
function FastCharPos(const aSource : string; const C: Char; StartPos : Integer) : Integer;
var
L : Integer;
begin
//If this assert failed, it is because you passed 0 for StartPos, lowest value is 1 !!
Assert(StartPos > 0);
Result := 0;
L := Length(aSource);
if L = 0 then exit;
if StartPos > L then exit;
Dec(StartPos);
asm
PUSH EDI //Preserve this register
mov EDI, aSource //Point EDI at aSource
add EDI, StartPos
mov ECX, L //Make a note of how many chars to search through
sub ECX, StartPos
mov AL, C //and which char we want :Error -"E2107 Operand size mismatch"
#Loop:
cmp Al, [EDI] //compare it against the SourceString
jz #Found
inc EDI
dec ECX
jnz #Loop
jmp #NotFound
#Found:
sub EDI, aSource //EDI has been incremented, so EDI-OrigAdress = Char pos !
inc EDI
mov Result, EDI
#NotFound:
POP EDI
end;
end;
function FastCharPosNoCase(const aSource : string; C: Char; StartPos : Integer) : Integer;
var
L : Integer;
begin
Result := 0;
L := Length(aSource);
if L = 0 then exit;
if StartPos > L then exit;
Dec(StartPos);
if StartPos < 0 then StartPos := 0;
asm
PUSH EDI //Preserve this register
PUSH EBX
mov EDX, GUpcaseLUT
mov EDI, aSource //Point EDI at aSource
add EDI, StartPos
mov ECX, L //Make a note of how many chars to search through
sub ECX, StartPos
xor EBX, EBX
mov BL, C //:Error -"E2107 Operand size mismatch"
mov AL, [EDX+EBX]
#Loop:
mov BL, [EDI]
inc EDI
cmp Al, [EDX+EBX]
jz #Found
dec ECX
jnz #Loop
jmp #NotFound
#Found:
sub EDI, aSource //EDI has been incremented, so EDI-OrigAdress = Char pos !
mov Result, EDI
#NotFound:
POP EBX
POP EDI
end;
end;
What do I need to update these two functions to XE7 win32?
What must I do?
Thanks.
This code was written for pre Unicode Delphi where Char is an alias for AnsiChar, the 8 bit character type. In Delphi 2009 and later, Char is an alias for WideChar the 16 bit character type.
The reason for the error message is that the code is intended to operate on 8 bit character elements, but you are providing 16 bit operands. The operator expects 8 bit operands, but you supplied 16 bit operands.
Change Char to AnsiChar to make this code compile and behave as intended on all versions of Delphi.
Having said that, I suggest you stop using this code. Instead use Pos. As a rule, it is preferable to use built-in library functions.
You should stop using old assembler version for string routines and use the use built-in library functions.
If you want to move on in a hurry you can reimplement you functions like this:
function FastCharPos(const aSource: string; const C: Char; StartPos: Integer): Integer; inline;
begin
Result := Pos(C, aSource, StartPos);
end;
function FastCharPosNoCase(const aSource: string; C: Char; StartPos: Integer): Integer; inline;
begin
Result := Pos(AnsiUppercase(C), AnsiUppercase(aSource), StartPos);
end;
please i've this GCC inline assembler piece of code
int src = 0;
dword n;
__asm(
"sar %%cl,%%edx"
: "=d" (n) // saves in eax,edx
: "c" (src), "d" (n) // the inputs
);
and my delphi attempt is :
asm
mov ecx, &src
mov edx, &n
sar cl,edx
mov eax,edx
end;
please is that correct ?
Inline assembler does not work the same way in Delphi as it does in GCC. For starters, you don't have the same kind of macro and template support in Delphi, so if you want to use a declare-once general purpose assembler routine, you have to declare it as a function:
function ShiftArithmeticRight(aShift: Byte; aValue: LongInt): LongInt;
{$IFDEF WIN64}
asm
sar edx,cl
mov eax,edx
end;
{$ELSE}
{$IFDEF CPU386}
asm
mov cl,al
sar edx,cl
mov eax,edx
end;
{$ELSE}
begin
if aValue < 0 then
Result := not (not aValue shr aShift)
else
Result := aValue shr aShift;
end;
{$ENDIF}
{$ENDIF}
In Delphi, inline assembler has to be implemented at the spot where it is used, and it is only supported in 32-bit. In such asm blocks you can use the EAX,ECX,EDX freely, plus any identifiers in the surrounding code. For instance:
var
lValue: LongInt;
lShift: Byte;
begin
// Enter pascal code here
asm
mov cl,lShift
sar lValue,cl
end;
// Enter pascal code here
end;
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.
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.