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 want to have universal way of detecting specific CPU features. For this task I've created this function which takes EAX leaf number,Register name and bit number and returns true or false. It works fine for MMX/SSEx/AVX (EAX=1) but it does not detect AVX2 (EAX=7).
CPU: i5-4670k
OS: Windows 7
DetectCPUFeature('1','EDX',23) //DETECTS MMX CORRECTLY
DetectCPUFeature('1','EDX',25) //DETECTS SSE CORRECTLY
DetectCPUFeature('1','EDX',26) //DETECTS SSE2 CORRECTLY
DetectCPUFeature('1','ECX',0) //DETECTS SSE3 CORRECTLY
DetectCPUFeature('1','ECX',9) //DETECTS SSSE3 CORRECTLY
DetectCPUFeature('1','ECX',19) //DETECTS SSE4.1 CORRECTLY
DetectCPUFeature('1','ECX',20) //DETECTS SSE4.2 CORRECTLY
DetectCPUFeature('1','ECX',28) //DETECTS AVX CORRECTLY
DetectCPUFeature('7','EBX',5) //DOES NOT DETECT AVX2!
.
function DetectCPUFeature(EAX_Leaf_HEX,Register_Name:string;Bit:byte):boolean;
var _eax,_ebx,_ecx,_edx,EAX_Leaf,_Result: Longword;
x:integer;
Binary_mask:string;
Decimal_mask:int64;
begin
EAX_Leaf:=HexToInt(EAX_Leaf_HEX);
Binary_mask:='1';
for x:=1 to Bit do Binary_mask:=Binary_mask+'0';
Decimal_mask:=BinToInt(Binary_mask);
if AnsiUpperCase(Register_Name)='EDX' then
begin
asm
mov eax,EAX_Leaf // https://en.wikipedia.org/wiki/CPUID
db $0F,$A2 // db $0F,$A2 = CPUID instruction
mov _Result,edx
end;
end;
if AnsiUpperCase(Register_Name)='ECX' then
begin
asm
mov eax,EAX_Leaf
db $0F,$A2
mov _Result,ecx
end;
end;
if AnsiUpperCase(Register_Name)='EBX' then
begin
asm
mov eax,EAX_Leaf
db $0F,$A2
mov _Result,ebx
end;
end;
if (_Result and Decimal_mask) = Decimal_mask then DetectCPUFeature:=true
else DetectCPUFeature:=false;
end;
This sort of code is very dubious, mixing asm with Pascal code. Your code, in the asm blocks modifies registers and fails to restore them. That could easily be conflicting with the compiler's register usage. My strong advice to you is that you should never mix asm and Pascal in this way. Always use pure Pascal or pure asm.
What you need is a function that will perform the CPUID instruction and return you all the registers in a structure. You can then pick out what you want from that using Pascal code.
In addition, as #J... points out, you need to specify the sub-leaf value in the ECX register before invoking the CPUID instruction. That is a requirement for a number of the more recently added CPUID arguments.
This is the function you need:
type
TCPUID = record
EAX: Cardinal;
EBX: Cardinal;
ECX: Cardinal;
EDX: Cardinal;
end;
function GetCPUID(Leaf, Subleaf: Cardinal): TCPUID;
asm
push ebx
push edi
mov edi, ecx
mov ecx, edx
cpuid
mov [edi+$0], eax
mov [edi+$4], ebx
mov [edi+$8], ecx
mov [edi+$c], edx
pop edi
pop ebx
end;
I've written this for 32 bit code, but if you need to support 64 bit code also that support is easy enough to add.
function GetCPUID(Leaf, Subleaf: Integer): TCPUID;
asm
{$IF Defined(CPUX86)}
push ebx
push edi
mov edi, ecx
mov ecx, edx
cpuid
mov [edi+$0], eax
mov [edi+$4], ebx
mov [edi+$8], ecx
mov [edi+$c], edx
pop edi
pop ebx
{$ELSEIF Defined(CPUX64)}
mov r9,rcx
mov ecx,r8d
mov r8,rbx
mov eax,edx
cpuid
mov [r9+$0], eax
mov [r9+$4], ebx
mov [r9+$8], ecx
mov [r9+$c], edx
mov rbx, r8
{$ELSE}
{$Message Fatal 'GetCPUID has not been implemented for this architecture.'}
{$IFEND}
end;
With this at hand you can call CPUID passing any value as input, and retrieve all 4 registers of output, with which you can then do whatever you please.
Your code to create a bitmask is extremely inefficient and very far from idiomatic. Use 1 shl N to create a value with a single bit set, in position N.
Code like this:
if (_Result and Decimal_mask) = Decimal_mask then DetectCPUFeature:=true
else DetectCPUFeature:=false;
is also some way from idiomatic. That would normally be written like this:
DetectCPUFeature := value and mask <> 0;
You might end up with a wrapper function that looks like this:
type
TCPUIDRegister = (regEAX, regEBX, regECX, regEDX);
function GetCPUIDRegister(CPUID: TCPUID; Reg: TCPUIDRegister): Cardinal;
begin
case Reg of
regEAX:
Result := CPUID.EAX;
regEBX:
Result := CPUID.EBX;
regECX:
Result := CPUID.ECX;
regEDX:
Result := CPUID.EDX;
end;
end;
function CPUFeatureEnabled(Leaf, Subleaf: Cardinal; Reg: TCPUIDRegister; Bit: Integer): Boolean;
var
value: Cardinal;
begin
value := GetCPUIDRegister(GetCPUID(Leaf, Subleaf), Reg);
Result := value and (1 shl Bit) <> 0;
end;
While David's answer is excellent, the reason the function fails is that the ECX register is not set to zero (required for fetching extended info in the CPUID call).
See : How to detect New Instruction support in the 4th generation Intel® Core™ processor family
where AVX2 is found by (emphasis mine)
CPUID.(EAX=07H, ECX=0H):EBX.AVX2[bit 5]==1
The following correctly returns the extended information and identifies AVX2 support.
if AnsiUpperCase(Register_Name)='EBX' then
begin
asm
push ecx { push ecx to stack}
mov ecx, 0 { set ecx to zero}
mov eax,EAX_Leaf
db $0F,$A2
mov _Result,ebx
pop ecx { restore ecx}
end;
The other asm functions have the same error as ECX is required to be zero for those calls also.
taken from Synopse Informatique:
type
/// the potential features, retrieved from an Intel CPU
// - see https://en.wikipedia.org/wiki/CPUID#EAX.3D1:_Processor_Info_and_Feature_Bits
TALIntelCpuFeature =
( { in EDX }
cfFPU, cfVME, cfDE, cfPSE, cfTSC, cfMSR, cfPAE, cfMCE,
cfCX8, cfAPIC, cf_d10, cfSEP, cfMTRR, cfPGE, cfMCA, cfCMOV,
cfPAT, cfPSE36, cfPSN, cfCLFSH, cf_d20, cfDS, cfACPI, cfMMX,
cfFXSR, cfSSE, cfSSE2, cfSS, cfHTT, cfTM, cfIA64, cfPBE,
{ in ECX }
cfSSE3, cfCLMUL, cfDS64, cfMON, cfDSCPL, cfVMX, cfSMX, cfEST,
cfTM2, cfSSSE3, cfCID, cfSDBG, cfFMA, cfCX16, cfXTPR, cfPDCM,
cf_c16, cfPCID, cfDCA, cfSSE41, cfSSE42, cfX2A, cfMOVBE, cfPOPCNT,
cfTSC2, cfAESNI, cfXS, cfOSXS, cfAVX, cfF16C, cfRAND, cfHYP,
{ extended features in EBX, ECX }
cfFSGS, cf_b01, cfSGX, cfBMI1, cfHLE, cfAVX2, cf_b06, cfSMEP, cfBMI2,
cfERMS, cfINVPCID, cfRTM, cfPQM, cf_b13, cfMPX, cfPQE, cfAVX512F,
cfAVX512DQ, cfRDSEED, cfADX, cfSMAP, cfAVX512IFMA, cfPCOMMIT,
cfCLFLUSH, cfCLWB, cfIPT, cfAVX512PF, cfAVX512ER, cfAVX512CD,
cfSHA, cfAVX512BW, cfAVX512VL, cfPREFW1, cfAVX512VBMI);
/// all features, as retrieved from an Intel CPU
TALIntelCpuFeatures = set of TALIntelCpuFeature;
var
/// the available CPU features, as recognized at program startup
ALCpuFeatures: TALIntelCpuFeatures;
{**}
type
_TRegisters = record
eax,ebx,ecx,edx: cardinal;
end;
{***************************************************************}
procedure _GetCPUID(Param: Cardinal; var Registers: _TRegisters);
{$IF defined(CPU64BITS)}
asm // ecx=param, rdx=Registers (Linux: edi,rsi)
.NOFRAME
mov eax, ecx
mov r9, rdx
mov r10, rbx // preserve rbx
xor ebx, ebx
xor ecx, ecx
xor edx, edx
cpuid
mov _TRegisters(r9).&eax, eax
mov _TRegisters(r9).&ebx, ebx
mov _TRegisters(r9).&ecx, ecx
mov _TRegisters(r9).&edx, edx
mov rbx, r10
end;
{$else}
asm
push esi
push edi
mov esi, edx
mov edi, eax
pushfd
pop eax
mov edx, eax
xor eax, $200000
push eax
popfd
pushfd
pop eax
xor eax, edx
jz #nocpuid
push ebx
mov eax, edi
xor ecx, ecx
cpuid
mov _TRegisters(esi).&eax, eax
mov _TRegisters(esi).&ebx, ebx
mov _TRegisters(esi).&ecx, ecx
mov _TRegisters(esi).&edx, edx
pop ebx
#nocpuid:
pop edi
pop esi
end;
{$ifend}
{******************************}
procedure _TestIntelCpuFeatures;
var regs: _TRegisters;
begin
regs.edx := 0;
regs.ecx := 0;
_GetCPUID(1,regs);
PIntegerArray(#ALCpuFeatures)^[0] := regs.edx;
PIntegerArray(#ALCpuFeatures)^[1] := regs.ecx;
_GetCPUID(7,regs);
PIntegerArray(#ALCpuFeatures)^[2] := regs.ebx;
PByteArray(#ALCpuFeatures)^[12] := regs.ecx;
end;
initialization
_TestIntelCpuFeatures;
I have the following function that works in Delphi 2006, but under Delphi XE2 it gives either an access violation error or a privileged instruction error when processing RET.
function Q_TrimChar(const S: string; Ch: Char): string;
asm
PUSH ESI
MOV ESI,ECX
TEST EAX,EAX
JE ##qt
MOV ECX,[EAX-4]
TEST ECX,ECX
JE ##qt
PUSH EBX
PUSH EDI
MOV EBX,EAX
MOV EDI,EDX
XOR EDX,EDX
MOV EAX,ESI
CALL System.#LStrFromPCharLen
MOV EDX,EDI
MOV ECX,[EBX-4]
##lp1: CMP DL,BYTE PTR [EBX]
JNE ##ex1
INC EBX
DEC ECX
JNE ##lp1
MOV EDX,[ESI]
JMP ##wq
##ex1: DEC ECX
##lp2: CMP DL,BYTE PTR [EBX+ECX]
JNE ##ex2
DEC ECX
JMP ##lp2
##ex2: MOV EDI,[ESI]
LEA EDX,[EDI+ECX+1]
##lp3: MOV AL,BYTE PTR [EBX+ECX]
MOV BYTE PTR [EDI+ECX],AL
DEC ECX
JNS ##lp3
##wq: MOV EAX,[ESI]
MOV BYTE PTR [EDX],0
SUB EDX,EAX
MOV [EAX-4],EDX
POP EDI
POP EBX
POP ESI
RET
##qt: MOV EAX,ESI
CALL System.#LStrClr
POP ESI
end;
I don't know assembly very well. What is the problem?
I completely agree with David's suggestion to simply code this in Pascal and have upvoted that answer. Unless profiling has indicated that this is a true bottleneck then there's really no need for the ASM. Here are two versions. The first is easier to read but the second is more efficient:
function Q_TrimChar(const S: string; Ch: Char): string;
begin
result := S;
while (result <> '') and (result[1] = Ch) do Delete(Result, 1, 1);
while (result <> '') and (result[Length(Result)] = Ch) do Delete(Result, Length(Result), 1);
end;
function Q_TrimChar(const S: string; Ch: Char): string;
var
First, Last : integer;
begin
First := 1;
Last := Length(S);
while (First < Last) and (S[First] = Ch) do inc(First);
while (Last >= First) and (S[Last] = Ch) do Dec(Last);
Result := copy(S, First, Last-First+1);
end;
Delphi 2006 uses single byte ANSI characters and so string is AnsiString, Char is AnsiChar. On Delphi 2009 and later, two byte Unicode characters are used. This function cannot possibly work on both compilers.
Even the standard hack of using AnsiString and AnsiChar does not work. Most likely the assumptions that this function makes about the RTL implementation are no longer valid in modern Delphi.
I would re-write this function in Pascal and let the compiler do the work. Not only will that be the quickest way to solve your current problem, it will also get you over the hurdle of 64-bit compilation should you ever choose to tackle that.
I am trying to implement FNV hash from http://isthe.com/chongo/tech/comp/fnv/
I converted the PowerBasic's inline asm on that page into Delphi.
function ReadFileToMem(sPath:string):Pointer;
var
hFile: THandle;
pBuffer: Pointer;
dSize: DWORD;
dRead: DWORD;
begin
hFile := CreateFile(PChar(sPath), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0);
if hFile <> 0 then
dSize := GetFileSize(hFile, nil);
if dSize <> 0 then
begin
SetFilePointer(hFile, 0, nil, FILE_BEGIN);
GetMem(Result, dSize);
ReadFile(hFile, Result^, dSize, dRead, nil);
if dRead = 0 then
MessageBox(0, PChar('Error reading file.'), PChar('Read Error'), MB_ICONEXCLAMATION)
end;
CloseHandle(hFile);
end;
function GetPointerSize(lpBuffer: Pointer): Cardinal; // Function by ErazerZ
begin
if lpBuffer = nil then
Result := Cardinal(-1)
else
Result := Cardinal(Pointer(Cardinal(lpBuffer) -4)^) and $7FFFFFFC -4;
end;
FUNCTION FNV32( dwOffset : Pointer; dwLen : DWORD; offset_basis : DWORD) : DWORD ;
asm
mov esi, dwOffset //;esi = ptr to buffer
mov ecx, dwLen //;ecx = length of buffer (counter)
mov eax, offset_basis //;set to 2166136261 for FNV-1
mov edi, 16777619//&h01000193 //;FNV_32_PRIME = 16777619
xor ebx, ebx //;ebx = 0
#nextbyte:
mul edi //;eax = eax * FNV_32_PRIME
mov bl, [esi] //;bl = byte from esi
xor eax, ebx //;al = al xor bl
inc esi //;esi = esi + 1 (buffer pos)
dec ecx //;ecx = ecx - 1 (counter)
jnz #nextbyte //;if ecx is 0, jmp to NextByte
mov #result, eax //;else, function = eax
end;
procedure TForm1.Button1Click(Sender: TObject);
var
pFile : Pointer;
hFile : Cardinal;
begin
//Profiler1['Test'].Start;
pFile := ReadFileToMem(fn);
hFile := FNV32(pFile,GetPointerSize(pFile),2166136261);
//Profiler1['Test'].Stop;
//OutputDebugString(pchar(Profiler1['Test'].AsText[tiAll]));
OutputDebugString(pchar(inttostr(hFile)));
end;
If a size of given file is more that 200KB, the output is random (hash) number. Am I missing something?
Your asm code is somewhat buggy, IMHO. It will crash your application, as it is written.
You need to preseve esi/edi/ebx registers
parameters are passed in eax,ecx,edx registers
result is the eax register
Correct way to do it could be (not tested, just written here there):
function fnv32(dwOffset : Pointer; dwLen : DWORD; offset_basis: DWORD) : DWORD ;
asm // eax=dwOffset ecx=dwLen edx=offset_basis -> result in eax
push esi
push edi
mov esi,eax
mov eax,edx
or ecx,ecx
je #z
mov edi,16777619
xor edx,edx
#1:
mul edi
mov dl,[esi]
xor eax,edx
inc esi
dec ecx
jnz #1
#z:
pop edi
pop esi
end;
So to read and hash any file, in a pure Delphi way (don't use Windows API like you did):
function fnv32file(const aFileName: TFileName): DWORD;
begin
with TMemoryStream.Create do
try
LoadFromFile(aFileName);
result := fnv32(Memory,Size,0);
finally
Free;
end;
end;
A pure pascal version won't be much slower IMHO (the bottleneck is definitively reading the data from the hard drive):
function fnv32(dwOffset : PByteArray; dwLen : DWORD; offset_basis: DWORD): DWORD ;
var i: integer;
begin
result := offset_basis;
for i := 0 to dwLen-1 do
result := (result*16777619) xor DWORD(dwOffset^[i]);
end;
Where should I start ...
1) CreateFile returns INVALID_HANDLE_VALUE on failure, not 0.
2) SetFilePointer is not necessary.
3) What if you have to hash 16 GB file?
4) You are not releasing allocated memory - FreeMem(pFile).
5) GetPointerSize is a total hack. You could just return file size from ReadFileToMem.
The following code is a rewrite of your approach. It still loads complete file into the memory but is implemented "the Delphi way".
function ReadFileToMem(const sPath: string; var buffer: TMemoryStream): boolean;
var
fileStr: TFileStream;
begin
Result := false;
try
fileStr := TFileStream.Create(sPath, fmOpenRead);
try
buffer.Size := 0;
buffer.CopyFrom(fileStr, 0);
finally FreeAndNil(fileStr); end;
Result := true;
except
on E: EFOpenError do
ShowMessage('Error reading file. ' + E.Message);
end;
end;
function FNV32(dwOffset: pointer; dwLen: cardinal; offset_basis: cardinal): cardinal;
asm
mov esi, dwOffset //;esi = ptr to buffer
mov ecx, dwLen //;ecx = length of buffer (counter)
mov eax, offset_basis //;set to 2166136261 for FNV-1
mov edi, 16777619//&h01000193 //;FNV_32_PRIME = 16777619
xor ebx, ebx //;ebx = 0
#nextbyte:
mul edi //;eax = eax * FNV_32_PRIME
mov bl, [esi] //;bl = byte from esi
xor eax, ebx //;al = al xor bl
inc esi //;esi = esi + 1 (buffer pos)
dec ecx //;ecx = ecx - 1 (counter)
jnz #nextbyte //;if ecx is 0, jmp to NextByte
mov #result, eax //;else, function = eax
end;
procedure TForm16.Button1Click(Sender: TObject);
var
hFile : cardinal;
memBuf: TMemoryStream;
begin
memBuf := TMemoryStream.Create;
try
if ReadFileToMem('SomeFile', memBuf) then begin
hFile := FNV32(memBuf.Memory, memBuf.Size, 2166136261);
ShowMessageFmt('Hash = %d', [hFile]);
end;
finally FreeAndNil(memBuf); end;
end;
Enjoy
function fnv(dwOffset : Pointer; dwLen : NativeUInt; offset_basis: NativeUInt) : NativeUInt ;
//
// http://find.fnvhash.com/ - FNV Hash Calculator Online
// http://www.isthe.com/chongo/tech/comp/fnv/
//
// The offset_basis for FNV-1 is dependent on n, the size of the hash:
// 32 bit offset_basis = 2166136261
// 64 bit offset_basis = 14695981039346656037
//
{$IF Defined(CPUX86)}
asm
push ebp
push edi
push ebx // statement must preserve the EDI, ESI, ESP, EBP, and EBX registers
mov ebp, edx
mov edx, ecx // but can freely modify the EAX, ECX, and EDX registers
mov ecx, eax
mov eax, edx
mov edi, 01000193h
xor ebx, ebx
##nexta:
mov bl, byte ptr [ecx]
xor eax, ebx
mul edi
inc ecx
dec ebp
jnz ##nexta
pop ebx
pop edi
pop ebp
end;
{$ELSEIF Defined(CPUX64)}
asm
mov rax, R8
mov r8, rdx
mov r9, 100000001b3h
xor r10, r10
##nexta:
mov r10b, byte ptr [rcx]
xor rax, r10
mul r9
inc rcx
dec r8
jnz ##nexta
end;
{$IFEND}
I written an asm function in Delphi 7 but it transforms my code to something else:
function f(x: Cardinal): Cardinal; register;
label err;
asm
not eax
mov edx,eax
shr edx, 1
and eax, edx
bsf ecx, eax
jz err
mov eax, 1
shl eax, cl
mov edx, eax
add edx, edx
or eax, edx
ret
err:
xor eax, eax
end;
// compiled version
f:
push ebx // !!!
not eax
mov edx,eax
shr edx, 1
and eax, edx
bsf ecx, eax
jz +$0e
mov eax, 1
shl eax, cl
mov edx, eax
add edx, edx
or eax, edx
ret
err:
xor eax, eax
mov eax, ebx // !!!
pop ebx // !!!
ret
// the almost equivalent without asm
function f(x: Cardinal): Cardinal;
var
c: Cardinal;
begin
x := not x;
x := x and x shr 1;
if x <> 0 then
begin
c := bsf(x); // bitscanforward
x := 1 shl c;
Result := x or (x shl 1)
end
else
Result := 0;
end;
Why does it generate push ebx and pop ebx? And why does it do mov eax, ebx?
It seems that it generates the partial stack frame because of the mov eax, ebx.
This simple test generates mov eax, edx but doesn't generate that stack frame:
function asmtest(x: Cardinal): Cardinal; register;
label err;
asm
not eax
and eax, 1
jz err
ret
err:
xor eax, eax
end;
// compiled
asmtest:
not eax
and eax, $01
jz +$01
ret
xor eax, eax
mov eax, edx // !!!
ret
It seems that it has something to do with the label err. If I remove that I don't get the mov eax, * part.
Why does this happen?
Made a bug report on Quality Central.
The practical advice is: do not use label keyword in asm code, use ##-prefixed labels:
function f(x: Cardinal): Cardinal; register;
asm
not eax
mov edx,eax
shr edx, 1
and eax, edx
bsf ecx, eax
jz ##err
mov eax, 1
shl eax, cl
mov edx, eax
add edx, edx
or eax, edx
ret
##err:
xor eax, eax
end;
Updated:
I have not found the bug report in Basm area. It looks like a bug, but I have used BASM for many years and never thought about using label keyword such a way. In fact I never used label keyword in Delphi at all. :)
Well ... back then, in the Delphi-Manual, it used to say something about Compiler-Optimization and thealike-crazyness:
The Compiler generates Stackframes only for nested Routines, for Routines having local Variables and for Routines with Stack-Parameters
The auto-generated Initialization- and Finalizationcode for Routines includes:
PUSH EBP ; If Locals <> 0 or Params <> 0
MOV EBP,ESP ; If Locals <> 0 or Params <> 0
SUB ESP,Locals ; If Locals <> 0
...
MOV ESP,EBP ; If Locals <> 0
POP EBP ; If Locals <> 0 or Params <> 0
RET Params ; Always
If local Variables contain Variants, long Strings or Interfaces they are initialized with Null but aren't finalized afterwards.
Locals is the Size of local Variables, Params the Size of Parameters. If both Locals as well as Params are Null no Init-Code will be generated and the Finalizationcode only contains a RET-Intruction.
Maybe that has got something to do with it all...