Delphi label and asm weirdness? - delphi

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...

Related

Code detects MMX/SSE/AVX but not AVX2

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;

UserProperties.Add in outlook2007 gets Invalid Function error

I'm working with Delphi2010 .
When I run the code with Outlook 2003 SP3, I get no errors but on another pc with outlook2007 i get an error 'Invalid Function error'.
const
olMailItem = 0;
olFolderInbox = $00000006;
var
Outlook: OleVariant;
oNameSpace: OleVariant;
oFolder: Olevariant;
oMailItem: Variant;
oUserProperty: Olevariant;
begin
try
Outlook := GetActiveOleObject('Outlook.Application');
except
Outlook := CreateOleObject('Outlook.Application');
end;
oNameSpace := Outlook.GetNamespace('MAPI') ;
oFolder:= oNameSpace.GetDefaultFolder(olFolderInbox);
oMailItem := Outlook.CreateItem(olMailItem);
...
oUserProperty:= oMailItem.UserProperties.Add('RetrieveCode', 1); //--> get error on Outlook2007
oUserProperty.Value:=ARetrieveCode;
...
end;
When I use redemption I get the same error for Outlook2007
Can someone point the right direction to solve this problem?
I catch the error with eurekalog:
; ComObj (Line=0 - Offset=0)
; --------------------------
00538469 mov eax, dword ptr [EOleSysError]
0053846E call ComObj
00538473 mov esi, eax
00538475 cmp dword ptr [ebp-$04], +$00
00538479 jz ComObj
0053847B push dword ptr [ebp-$04]
0053847E mov eax, esi
00538480 jmp System
00538485 jmp ComObj
00538487 mov eax, esi
00538489 call System ; <-- EXCEPTION
0053848E xor eax, eax
00538490 pop edx
00538491 pop ecx
00538492 pop ecx
00538493 mov fs:[eax], edx
00538496 push $005384B0 ; '^[‹å]Â.'
0053849B lea eax, [ebp-$10]
0053849E mov edx, $00000003 ; ''...
005384A3 call System
005384A8 ret
I have change my code from late-bound to early-bound to check if I get the same error.
I imported the library to OutLook_TLB.pas and add the Outlook_TLB in the uses of the unit.
uses
...,
Outlook_TLB;
function SendOutLookMail ...
var
...
MyOutlook: Outlook_TLB.OutlookApplication;
MyMailItem: Outlook_TLB.MailItem;
MyUserProperty: Outlook_TLB.UserProperty;
begin
...
MyOutlook:= Outlook_TLB.CoOutlookApplication.Create;
MyMailItem:= MyOutlook.CreateItem(olMailItem)as MailItem;
MyUserProperty:= MyMailItem.UserProperties.Add('RetrieveCode', 1, EmptyParam, EmptyParam) as UserProperty;
MyUserProperty.Value:= ARetrieveCode;
MyMailItem.Recipients.Add(AFrom);
MyMailItem.To_:= ATo;
MyMailItem.Subject := ASubject+' early/late-bound';
MyMailItem.Body := ABody;
MyMailItem.Send;
end;
When I run the code, I don't have any error on a pc with Outlook2007.
So an early bound to the object fixed my problem.

What does DUnit2's CallerAddr function do, and how do I convert it to 64 bits?

I am trying to get DUnit2 working under 64 bits, but I am stumped to what this method does, let alone how to convert it to 64 bits. Pure Pascal would better, but since it refers to the stack (ebp), it might not be possible.
function CallerAddr: Pointer; assembler;
const
CallerIP = $4;
asm
mov eax, ebp
call IsBadPointer
test eax,eax
jne ##Error
mov eax, [ebp].CallerIP
sub eax, 5 // 5 bytes for call
push eax
call IsBadPointer
test eax,eax
pop eax
je ##Finish
##Error:
xor eax, eax
##Finish:
end;
function RtlCaptureStackBackTrace(FramesToSkip: ULONG; FramesToCapture: ULONG;
out BackTrace: Pointer; BackTraceHash: PULONG): USHORT; stdcall;
external 'kernel32.dll' name 'RtlCaptureStackBackTrace' delayed;
function CallerAddr: Pointer;
begin
// Skip 2 Frames, one for the return of CallerAddr and one for the
// return of RtlCaptureStackBackTrace
if RtlCaptureStackBackTrace(2, 1, Result, nil) > 0 then
begin
if not IsBadPointer(Result) then
Result := Pointer(NativeInt(Result) - 5)
else
Result := nil;
end
else
begin
Result := nil;
end;
end;
function CallerAddr: Pointer; assembler;
const
CallerIP = $4;
asm
mov rax, rcx ;For int.. XMM0 for float
call IsBadPointer
test rax,rax
jne ##Error
mov rax, [rcx].CallerIP
sub rax, 5 // 5 bytes for call
push rax
call IsBadPointer
test rax,rax
pop rax
je ##Finish
##Error:
xor rax, rax
##Finish:
end;

Delphi - Detect Int64 Overflow Error

In Delphi how can I detect overflow errors for Int64?
For Integers we could do:
type
MyInt = Integer; //Int64
function TryMaxTimes10(out Res: MyInt): boolean;
var
a, b: MyInt;
begin
{$Q+}
try
a := High(MyInt);
b := 10;
Res := a * b; //REF1
Result := True;
except
Result := False;
end;
{$Q-}
end;
For MyInt = Integer, line REF1 gives an exception and so TryMaxTimes10 returns false.
But if we change MyInt to MyInt = Int64, then REF1 does not give an exception and TryMaxTimes10 returns true!
I understand that the help for {$Q+} does not specifically mention Int64: ... {$Q+} state, certain integer arithmetic operations ... are checked for overflow.
QUESTION: So my question is, how can we detect overflow errors for Int64?
(I'm using Delphi 7. Does the same thing happen in newer versions of Delphi?)
This is a known issue. See http://qc.embarcadero.com/wc/qcmain.aspx?d=10185, and the comments Andy wrote at the bottom.
My suggestion would be to create a function (I did not compile nor test this - just an example):
function Foo(A, B : Int64) : Int64;
var bNeg : boolean;
begin
// Do we expect a negative result?
bNeg := ((a < 0) xor (b < 0));
// Get the real result
Result := a * b;
// If the result is wrong, raise an error
if ((Result < 0) xor bNeg) then begin
// Raise EOverFlow
end;
end;
This bug has been fixed in RAD Studio 10.2 Tokyo.
The issue can be found here (but one have to log in with embarcadero account to see it).
Here is correct version of __llmulo by John O'Harrow (licensed under MPL 1.1) shipped with Delphi versions 10.2 and above:
// Param 1(edx:eax), Param 2([esp+8]:[esp+4])
// Result is stored in edx:eax
// O-flag set on exit => result is invalid
// O-flag clear on exit => result is valid
procedure __llmulo();
asm
test edx, edx {Param1-Hi = 0?}
jne ##Large {No, More than one multiply may be needed}
cmp edx, [esp+8] {Param2-Hi = 0?}
jne ##Large {No, More than one multiply may be needed}
mul dword ptr [esp+4] {Only one multiply needed, Set Result}
and eax, eax {Clear Overflow Flag}
ret 8
##Large:
sub esp, 28 {allocate local storage}
mov [esp], ebx {save used registers}
mov [esp+4], esi
mov [esp+8], edi
mov [esp+12], ebp
mov ebx, [esp+32] {Param2-Lo}
mov ecx, [esp+36] {Param2-Hi}
mov esi, edx
mov edi, ecx
sar esi, 31
sar edi, 31
xor eax, esi
xor edx, esi
sub eax, esi
sbb edx, esi {edx:eax (a1:a0) = abs(Param1)}
xor ebx, edi
xor ecx, edi
sub ebx, edi
sbb ecx, edi {ecx:ebx (b1:b0) = abs(Param2)}
xor esi, edi {Sign Flag, 0 if Params have same sign else -1}
mov [esp+16], eax {a0}
mov [esp+20], edx {a1}
mov [esp+24], ecx {b1}
mul ebx {edx:eax (c1:c0) = a0*b0}
xchg ebx, edx {ebx = c1, edx = b0}
mov edi, eax {abs(Result-Lo) = c0}
xor ecx, ecx {Upper 32 bits of 128 bit result}
xor ebp, ebp {Second 32 bits of 128 bit result}
mov eax, [esp+20] {a1}
mul edx {edx:eax (d1:d0) = a1*b0}
add ebx, eax {c1 + d0}
adc ebp, edx {d1 + carry}
adc ecx, 0 {Possible carry into Upper 32 bits}
mov eax, [esp+16] {a0}
mov edx, [esp+24] {b1}
mul edx {edx:eax (e1:e0) = a0*b1}
add ebx, eax {abs(Result-Hi) = c1 + d0 + e0}
adc ebp, edx {d1 + e1 + carry}
adc ecx, 0 {Possible carry into Upper 32 bits}
mov eax, [esp+20] {a1}
mov edx, [esp+24] {b1}
mul edx {edx:eax (f1:f0) = a1*b1}
add ebp, eax {d1 + e1 + f0 + carry}
adc ecx, edx {f1 + carry}
or ecx, ebp {Overflow if ecx <> 0 or ebp <> 0}
jnz ##Overflow
mov edx, ebx {Set abs(Result-Hi)}
mov eax, edi {Set abs(Result-Lo)}
cmp edx, $80000000
jae ##CheckRange {Possible Overflow if edx>=$80000000}
##SetSign:
xor eax, esi {Correct Sign of Result}
xor edx, esi
sub eax, esi
sbb edx, esi
mov ebx, [esp] {restore used registers}
mov esi, [esp+4]
mov edi, [esp+8]
mov ebp, [esp+12]
add esp, 28 {Clears Overflow flag}
ret 8
##CheckRange:
jne ##Overflow {Overflow if edx>$80000000}
test esi, esi {edx=$80000000, Is Sign Flag=0?}
jnz ##SetSign {No, Result is Ok (-MaxInt64)}
##Overflow:
mov ebx, [esp] {restore used registers}
mov esi, [esp+4]
mov edi, [esp+8]
mov ebp, [esp+12]
add esp, 28
mov ecx, $80000000
dec ecx {Set Overflow Flag}
ret 8
end;

Implementation of FNV

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}

Resources