SuperFastHash from Paul Hsieh Translated to Delphi and Borland Assembler (BASM)
How it started
Why this introduction? Well, the community lives in the Borland Newsgroup in the group borland.public.delphi.language.basm and it's also a general discussion place about 'hardcore' optimalizations for a Delphi function. More than a year ago Juhani Suhonen asked for a fast hash to use for his hashtable. I suggested the old but nicely performing elf-hash, but also noted a much better hash function I recently found. It was called SuperFastHash (SFH) and was created by Paul Hsieh to overcome his 'problems' with the hash functions from Bob Jenkins. Juhani asked if somebody could write the SFH function in basm. A few people worked on a basm implementation and posted it.
In this post I will roughly describe how I as a fresh assembler optimizer created my version of the SFH function.
The Delphi implementation
I started with a regular Delphi implementation of the algorithm, using the c code from Paul's article as reference. After I got my Delphi implementation compiled and working I looked at the BASM code using the CPU debug view and tried to find points where I could help the Delphi compiler generating better assembly. Below is my initial pascal version. (beware I will post my final version later on in this post).
function SuperFastHash(AData:pointer; ADataLength: integer):longword;
// Pascal translation of the SuperFastHash function by Paul Hsieh
// more info: http://www.azillionmonkeys.com/qed/hash.html
// Translation by: Davy Landman
// No warranties, but have fun :)
var
TempPart: longword;
RemainingBytes: integer;
begin
if not Assigned(AData) or (ADataLength <= 0) then
begin
Result := 0;
Exit;
end;
Result := ADataLength;
RemainingBytes := ADataLength and 3;
ADataLength := ADataLength shr 2; // div 4, so var name is not correct anymore..
// main loop
while ADataLength > 0 do
begin
inc(Result, PWord(AData)^);
TempPart := (PWord(Pointer(Cardinal(AData)+2))^ shl 11) xor Result;
Result := (Result shl 16) xor TempPart;
AData := Pointer(Cardinal(AData) + 4);
inc(Result, Result shr 11);
dec(ADataLength);
end;
// end case
if RemainingBytes = 3 then
begin
inc(Result, PWord(AData)^);
Result := Result xor (Result shl 16);
Result := Result xor (PByte(Pointer(Cardinal(AData)+2))^ shl 18);
inc(Result, Result shr 11);
end
else if RemainingBytes = 2 then
begin
inc(Result, PWord(AData)^);
Result := Result xor (Result shl 11);
inc(Result, Result shr 17);
end
else if RemainingBytes = 1 then
begin
inc(Result, PByte(AData)^);
Result := Result xor (Result shl 10);
inc(Result, Result shr 1);
end;
// avalance
Result := Result xor (Result shl 3);
inc(Result, Result shr 5);
Result := Result xor (Result shl 4);
inc(Result, Result shr 17);
Result := Result xor (Result shl 25);
inc(Result, Result shr 6);
end;Warning this is not final code!
The BASM implementation
I posted this and later posted an assembly version of SFH, I used the CPU view and the code suggestions from Bob Gonder to create this BASM code. Using BASM you can control the exact usage of registers and you're able to fine tune the assembly much better (and easier) than writing Delphi code.
My enthusiasm got the better of me and I spent a whole lot of evenings optimizing the Delphi and assembly versions of the SFH function (while I should have been working on my graduation internship paper). The discussion on the newsgroup turned a few interesting corners about the different kind of definitions of a hashing function. Therefor I must note that this function should only be used for a hashtable! It's tuned for giving a good distribution but not for cryptographically or verification usage.
The final unit
I think I've posted my final functions in the discussion thread, but recently I created a separate function file including some new parts. For instance, I added an functions for larger data which is the same algorithm, but uses less jumps because I unrolled the function. Below is my final unit of the SuperFastHash function.
unit unSuperFastHash;
(*
A Delphi and assembly translation of the SuperFastHash function by
Paul Hsieh (http://www.azillionmonkeys.com/qed/hash.html).
I got the idea for translating it due to borland.public.delphi.language.basm.
See the full discussion at:
http://groups.google.com/group/borland.public.delphi.language.basm/
browse_thread/thread/96482ba4d1d5a016/7745466ab714c3b3
***** BEGIN LICENSE BLOCK *****
* Version: MPL 1.1/GPL 2.0/LGPL 2.1
*
* The contents of this file are subject to the Mozilla Public License Version
* 1.1 (the "License"); you may not use this file except in compliance with
* the License. You may obtain a copy of the License at
* http://www.mozilla.org/MPL/
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
* for the specific language governing rights and limitations under the
* License.
*
* The Original Code is SuperFastHash Delphi and BASM translation.
*
* The Initial Developer of the Original Code is
* Davy Landman.
* Portions created by the Initial Developer are Copyright (C) 2007
* the Initial Developer. All Rights Reserved.
*
* Contributor(s):
*
*
* Alternatively, the contents of this file may be used under the terms of
* either the GNU General Public License Version 2 or later (the "GPL"), or
* the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
* in which case the provisions of the GPL or the LGPL are applicable instead
* of those above. If you wish to allow use of your version of this file only
* under the terms of either the GPL or the LGPL, and not to allow others to
* use your version of this file under the terms of the MPL, indicate your
* decision by deleting the provisions above and replace them with the notice
* and other provisions required by the GPL or the LGPL. If you do not delete
* the provisions above, a recipient may use your version of this file under
* the terms of any one of the MPL, the GPL or the LGPL.
*
* ***** END LICENSE BLOCK ***** *)
interface
{.$define ASMVersion}
function SuperFastHash(AData: pointer; ADataLength: Integer): Cardinal;
function SuperFastHashLargeData(AData: pointer; ADataLength: Integer): Cardinal;
implementation
// Pascal translation of the SuperFastHash function by Paul Hsieh
// more info: http://www.azillionmonkeys.com/qed/hash.html
function SuperFastHash(AData: pointer; ADataLength: Integer): Cardinal;
{$ifndef ASMVersion}
var
TempPart: Cardinal;
RemainingBytes: Integer;
RemainingDWords: Integer;
begin
if not Assigned(AData) or (ADataLength <= 0) then
begin
Result := 0;
Exit;
end;
Result := ADataLength;
RemainingBytes := ADataLength and 3; // mod 4
RemainingDWords := ADataLength shr 2; // div 4
// main loop
while RemainingDWords > 0 do
begin
Result := Result + PWord(AData)^;
// splitting the pointer math keeps the amount of registers pushed at 2
AData := Pointer(Cardinal(AData) + SizeOf(Word));
TempPart := (PWord(AData)^ shl 11) xor Result;
Result := (Result shl 16) xor TempPart;
AData := Pointer(Cardinal(AData) + SizeOf(Word));
Result := Result + (Result shr 11);
dec(RemainingDWords);
end;
// Handle end cases
if RemainingBytes = 3 then
begin
Result := Result + PWord(AData)^;
Result := Result xor (Result shl 16);
AData := Pointer(Cardinal(AData) + SizeOf(Word)); // skip to the last byte
Result := Result xor ((PByte(AData)^ shl 18));
Result := Result + (Result shr 11);
end
else if RemainingBytes = 2 then
begin
Result := Result + PWord(AData)^;
Result := Result xor (Result shl 11);
Result := Result + (Result shr 17);
end
else if RemainingBytes = 1 then
begin
Result := Result + PByte(AData)^;
Result := Result xor (Result shl 10);
Result := Result + (Result shr 1);
end;
// Force "avalanching" of final 127 bits
Result := Result xor (Result shl 3);
Result := Result + (Result shr 5);
Result := Result xor (Result shl 4);
Result := Result + (Result shr 17);
Result := Result xor (Result shl 25);
Result := Result + (Result shr 6);
{$else}
asm
push esi
push edi
test eax, eax // data
jz @Ret // eax is result
xchg edx, eax // swith data and length
test eax, eax // length, and hash
jle @Ret
@Start:
mov edi, eax
mov esi, eax
and edi, 3 // last few bytes
shr esi, 2 // number of DWORD loops
jz @Last3
@Loop:
movzx ecx, word ptr [edx]
add eax, ecx
movzx ecx, word ptr [edx + 2]
shl ecx, 11
xor ecx, eax
shl eax, 16
xor eax, ecx
mov ecx, eax
shr eax, 11
add eax, ecx
add edx, 4
dec esi
jnz @Loop
@Last3:
test edi, edi
jz @Done
dec edi
jz @OneLeft
dec edi
jz @TwoLeft
movzx ecx, word ptr [edx]
add eax, ecx
mov ecx, eax
shl eax, 16
xor eax, ecx
movsx ecx, byte ptr [edx + 2]
shl ecx, 18
xor eax, ecx
mov ecx, eax
shr ecx, 11
add eax, ecx
jmp @Done
@TwoLeft:
movzx ecx, word ptr [edx]
add eax, ecx
mov ecx, eax
shl eax, 11
xor eax, ecx
mov ecx, eax
shr eax, 17
add eax, ecx
jmp @Done
@OneLeft:
movsx ecx, byte ptr [edx]
add eax, ecx
mov ecx, eax
shl eax, 10
xor eax, ecx
mov ecx, eax
shr eax, 1
add eax, ecx
@Done:
// avalanche
mov ecx, eax
shl eax, 3
xor eax, ecx
mov ecx, eax
shr eax, 5
add eax, ecx
mov ecx, eax
shl eax, 4
xor eax, ecx
mov ecx, eax
shr eax, 17
add eax, ecx
mov ecx, eax
shl eax, 25
xor eax, ecx
mov ecx, eax
shr eax, 6
add eax, ecx
@Ret:
pop edi
pop esi
ret
{$endif}
end;
function SuperFastHashLargeData(AData: pointer; ADataLength: Integer): Cardinal;
{$ifndef ASMVersion}
type
TWordArray = array[0..(MaxInt div SizeOf(Word)) - 1] of Word;
PWordArray = ^TWordArray;
var
TempPart: Cardinal;
RemainingBytes: Integer;
RemainingDWords: Integer;
begin
if not Assigned(AData) or (ADataLength <= 0) then
begin
Result := 0;
Exit;
end;
Result := ADataLength;
RemainingBytes := ADataLength and 3;
RemainingDWords := ADataLength shr 2; // div 4
// large loop
while RemainingDWords >= 4 do
begin
Result := Result + PWord(AData)^;
TempPart := (PWordArray(AData)^[1] shl 11) xor Result;
Result := (Result shl 16) xor TempPart;
Result := Result + (Result shr 11);
Result := Result + PWordArray(AData)^[2];
TempPart := (PWordArray(AData)^[3] shl 11) xor Result;
Result := (Result shl 16) xor TempPart;
Result := Result + (Result shr 11);
Result := Result + PWordArray(AData)^[4];
TempPart := (PWordArray(AData)^[5] shl 11) xor Result;
Result := (Result shl 16) xor TempPart;
Result := Result + (Result shr 11);
Result := Result + PWordArray(AData)^[6];
TempPart := (PWordArray(AData)^[7] shl 11) xor Result;
Result := (Result shl 16) xor TempPart;
Result := Result + (Result shr 11);
// update the pointer and the counter
AData := Pointer(Cardinal(AData) + (8 * SizeOf(Word)));
RemainingDWords := RemainingDWords - 4;
end;
// small loop
while RemainingDWords > 0 do
begin
Result := Result + PWord(AData)^;
AData := Pointer(Cardinal(AData) + SizeOf(Word));
TempPart := (PWord(AData)^ shl 11) xor Result;
Result := (Result shl 16) xor TempPart;
AData := Pointer(Cardinal(AData) + SizeOf(Word));
Result := Result + (Result shr 11);
dec(RemainingDWords);
end;
// Handle end cases
if RemainingBytes = 3 then
begin
Result := Result + PWord(AData)^;
Result := Result xor (Result shl 16);
AData := Pointer(Cardinal(AData) + SizeOf(Word)); // skip to the last byte
Result := Result xor ((PByte(AData)^ shl 18));
Result := Result + (Result shr 11);
end
else if RemainingBytes = 2 then
begin
Result := Result + PWord(AData)^;
Result := Result xor (Result shl 11);
Result := Result + (Result shr 17);
end
else if RemainingBytes = 1 then
begin
Result := Result + PByte(AData)^;
Result := Result xor (Result shl 10);
Result := Result + (Result shr 1);
end;
// Force "avalanching" of final 127 bits
Result := Result xor (Result shl 3);
Result := Result + (Result shr 5);
Result := Result xor (Result shl 4);
Result := Result + (Result shr 17);
Result := Result xor (Result shl 25);
Result := Result + (Result shr 6);
{$else}
asm
push esi
push edi
test eax, eax // test for nil pointer
jz @Ret // eax is also result, so save ret here
xchg edx, eax // swith data and length
test eax, eax // length, and hash
jle @Ret
@Start:
mov edi, eax
mov esi, eax
and edi, 3 // last few bytes
shr esi, 2 // number of DWORD loops
jz @Last3
@LargeLoop:
cmp esi,$04
jl @Loop
// first DWORD
movzx ecx, word ptr [edx]
add eax, ecx
movzx ecx, word ptr [edx + 2]
shl ecx, 11
xor ecx, eax
shl eax, 16
xor eax, ecx
mov ecx, eax
shr eax, 11
add eax, ecx
// second DWORD
movzx ecx, word ptr [edx + 4]
add eax, ecx
movzx ecx, word ptr [edx + 6]
shl ecx, 11
xor ecx, eax
shl eax, 16
xor eax, ecx
mov ecx, eax
shr eax, 11
add eax, ecx
// third DWORD
movzx ecx, word ptr [edx + 8]
add eax, ecx
movzx ecx, word ptr [edx + 10]
shl ecx, 11
xor ecx, eax
shl eax, 16
xor eax, ecx
mov ecx, eax
shr eax, 11
add eax, ecx
// fourth DWORD
movzx ecx, word ptr [edx + 12]
add eax, ecx
movzx ecx, word ptr [edx + 14]
shl ecx, 11
xor ecx, eax
shl eax, 16
xor eax, ecx
mov ecx, eax
shr eax, 11
add eax, ecx
add edx, 16
sub esi, 4
jz @Last3
jmp @LargeLoop
@Loop:
movzx ecx, word ptr [edx]
add eax, ecx
movzx ecx, word ptr [edx + 2]
shl ecx, 11
xor ecx, eax
shl eax, 16
xor eax, ecx
mov ecx, eax
shr eax, 11
add eax, ecx
add edx, 4
dec esi
jnz @Loop
@Last3:
test edi, edi
jz @Done
dec edi
jz @OneLeft
dec edi
jz @TwoLeft
movzx ecx, word ptr [edx]
add eax, ecx
mov ecx, eax
shl eax, 16
xor eax, ecx
movsx ecx, byte ptr [edx + 2]
shl ecx, 18
xor eax, ecx
mov ecx, eax
shr ecx, 11
add eax, ecx
jmp @Done
@TwoLeft:
movzx ecx, word ptr [edx]
add eax, ecx
mov ecx, eax
shl eax, 11
xor eax, ecx
mov ecx, eax
shr eax, 17
add eax, ecx
jmp @Done
@OneLeft:
movsx ecx, byte ptr [edx]
add eax, ecx
mov ecx, eax
shl eax, 10
xor eax, ecx
mov ecx, eax
shr eax, 1
add eax, ecx
@Done:
// avalanche
mov ecx, eax
shl eax, 3
xor eax, ecx
mov ecx, eax
shr eax, 5
add eax, ecx
mov ecx, eax
shl eax, 4
xor eax, ecx
mov ecx, eax
shr eax, 17
add eax, ecx
mov ecx, eax
shl eax, 25
xor eax, ecx
mov ecx, eax
shr eax, 6
add eax, ecx
@Ret:
pop edi
pop esi
ret
{$endif}
end;
end.
To use this code you'll only have to download the unit and choose if you want to use the Pascal versions or the Assembly versions. You can switch between this using the {$define ASMVersion} preprocessor.
Difference between my version and Paul Hsieh's
The only difference between my Pascal code and Paul's c code is the pointer mathematics in the core loop. Below is the core loop c code.
for (;len > 0; len--) {
hash += get16bits (data);
tmp = (get16bits (data+2) << 11) ^ hash;
hash = (hash << 16) ^ tmp;
data += 2*sizeof (uint16_t);
hash += hash >> 11;
}
And this is my Pascal version of this code.
while RemainingDWords > 0 do
begin
Result := Result + PWord(AData)^;
// splitting the pointer math keeps the amount of registers pushed at 2
AData := Pointer(Cardinal(AData) + SizeOf(Word));
TempPart := (PWord(AData)^ shl 11) xor Result;
Result := (Result shl 16) xor TempPart;
AData := Pointer(Cardinal(AData) + SizeOf(Word));
Result := Result + (Result shr 11);
dec(RemainingDWords);
end;
Paul's code increments the pointer at the end data += 2*sizeof (uint16_t);, and uses get16bits (data+2) to get to the second Word while mine increases the data pointer in between, because the Delphi Compiler will not compile PWord(Pointer(Cardinal(AData)+2))^ into movzx ecx, word ptr [edx + 2] but will store the intermediate pointer in a extra register which causes performance loss.
The funny thing is, although I tried a lot of different ways to get a better performance I ended up with an implementation almost identical to Paul's. I hadn't found the assembly version he created until after I wrote my own, and I think it's nice to see that apart from the initialization and the case statement they are the same.
Next time I will post my benchmarking code.
My new blog
Three years back I created a blog with the idea to post my Delphi snippets on that blog for future reference. But the problem as usual, so many ideas, so little time. It also didn't help that I switched to C# about 1 and a half year ago. I still use Delphi sometimes, but not for my regular work.
In my work I've learned a lot about C# and web development (ASP.NET) and it gave me a few ideas to publish about, but the problem was, my blog was called Delphi Snippets. So I came up with the *very* original name "Landman Code".
Design
Big difference from the first time was that now I understand html and css enough to make a nice website myself (instead of using a blogspot template). Naturally Because I'm Dutch I wanted a free hosting solution, so I stayed with the nice Google Service called Blogger (or Blogspot?).
I started my first design for my blog in Paint.NET. After I got a general idea of what I wanted I started with a basic HTML frame. Being a programmer I like the idea of the separation of content (HTML) and layout (CSS) and I created in my opinion a very clean html template. I always aim to support IE6+ and FF2+ when creating a new website, and off course IE6 got most of my attention. The aim was to have a fluid layout (but with a max width) and also have the layout shape according to the text size instead of a fixed pixel size (apparently called an elastic layout).
Blogspot Template
After I finished my HTML template I started searching for an explanation about the XML templates from blogspot. The furthest I got was the help from blogger itself. So "developing" my XML template got a little bit of a drag, and without even an XSD to validate the XML the project had a rest period of about a month.
My new method was to find a reasonably clean template and "learn & copy" from that template to create my own template. I found that in the Nyoba 780 template. It was clean enough to understand how it worked and after a few evenings I finished my first blogspot template, so thanks for the inspiration Isnaini Dot Com .
Special features
I'm always proud of my work, and I try to learn every time a do a project. For this project I really wanted to dive deep into css and html. Here is a list of the thing's I'm particularly proud of.
- Using only 1 CSS hack (max-width IE6).
- Using valid HTML (the Blogspot navbar breaks everything).
- Round corner's using just a little bit extra html markup, I preferred the extra markup to the javascript solutions.
- Using png images with an alpha channel in an css background property and getting them to not be ugly in IE6 without using any hacks or filters. (TweakPNG to the rescue)
- Using my own basil plantage for the header image.
- The semi transparant box behind the title.
- Good usage of html tags (see the structure in FireBug)
Old Blog
I transferred the posts from my old blog to this blog at first for testing my template but also because I still like the idea of the old blog and want to keep my snippets in this blog.
So I hope you'll like the content (and design) of the blog.
Kind regards,
Davy Landman
ps. I recommend using ClearType (or Font Smoothing) for reading this blog, normally I wouldn't choose fonts which assume ClearTyping enabled, but because the intended audience are developers I assume you're using the features your Operating System offers you.
Welcome to my blog
Hello,
My name is Davy Landman and I'm a developer.
While working I develop mainly in ASP.NET and Winforms using the C# language, while sometimes developing Win32 applications in Delphi.
When not working and coding the utilities the inner geek wants, I use a mix of C#, Delphi, BASM and Matlab.
In this blog I post about some interesting code I found or created, mainly sharing it for reference later and anyone else who would like it.
Have fun.
Thread safe TStack (TThreadStack)
This post was migrated from my old blog delphi-snippets.blogspot.com, for explanation about this switch see my introduction post.
Recently i've been doing a lot of multithreading, and luckily Delphi provides with a handy bunch of classes to make the developers life easier. You've got some basic synchronization classes (TMutex, TEvent, TCriticalSection, TMultiReadExclusiveWriteSynchronizer...) and an basic data container (TThreadList). But for one program I needed a thread safe stack. In this post I will describe how I created my own.
There is not thread safe stack in Borland Turbo Delphi 2006, so off course I started with a Google for delphi TThreadStack, which at this time gives zero results. Searching the newsgroups I found an interesting group called comp.programming.threads, searching that group I found one Pascal Lock-Free stack (which basically means not using a critical section, or any other mechanism, to lock the data). But after testing it, FastMM pointed out an memory leak. I provided the author with a test case to cause the memory leak, but after 5 months no reply.
But I'm a hard person to please, and although it is indeed lock free, I was wondering if in my situation this lock-free solution wasn't to complicated and perhaps slower. So I created an simple TThreadStack from looking at the principle of the TThreadList (Very simple!), and compared it with the lock-free solution.
The source demonstrates is the test project.
program Project2;
{$APPTYPE CONSOLE}
uses
FastMM4,
unThreadStack,
FreeStack, Math,
Windows, SysUtils, Classes;
const
NumberOfAllocations = 1000;
PopTimeOut = 1;
PushTimeOut = 1;
NumberOfThreads = 8; // must be an multiple of 4
NumberOfTest = 10;
type
TTestRec = packed record
BigField: array[0..254] of Char;
SmallerField: Extended;
SmallField: Byte;
end;
PTestRec = ^TTestRec;
TFreeStackThread = class(TThread)
FPopper: Boolean;
FDestination: TFreeStack;
FFinished: THandle;
protected
procedure Execute; override;
public
constructor Create(ADestination: TFreeStack; APopper: Boolean; AFinished: THandle);
end;
TThreadStackThread = class(TThread)
FPopper: Boolean;
FDestination: TThreadStack;
FFinished: THandle;
protected
procedure Execute; override;
public
constructor Create(ADestination: TThreadStack; APopper: Boolean; AFinished: THandle);
end;
{ TThreadStackThread }
constructor TThreadStackThread.Create(ADestination: TThreadStack;
APopper: Boolean; AFinished: THandle);
begin
FDestination := ADestination;
FPopper := APopper;
FFinished := AFinished;
inherited Create(False);
end;
procedure TThreadStackThread.Execute;
var
TempStack: TStack;
p: PTestRec;
counter: Int64;
temp: LongWord;
begin
counter := 0;
while (not Terminated) and (counter < NumberOfAllocations) do
begin
TempStack := FDestination.LockStack;
try
if FPopper then
begin
if TempStack.Count > 0 then
begin
Dispose(PTestRec(TempStack.Pop));
inc(counter);
end;
end
else
begin
New(p);
TempStack.Push(p);
inc(counter);
end;
finally
FDestination.UnlockStack;
end;
if FPopper then
Sleep(PopTimeOut)
else
Sleep(PushTimeOut);
end;
ReleaseSemaphore(FFinished, 1, @temp);
end;
{ TFreeStackThread }
constructor TFreeStackThread.Create(ADestination: TFreeStack; APopper: Boolean; AFinished: THandle);
begin
FDestination := ADestination;
FPopper := APopper;
FFinished := AFinished;
inherited Create(False);
end;
procedure TFreeStackThread.Execute;
var
p: PTestRec;
counter: Int64;
temp: LongWord;
begin
counter := 0;
p := nil;
while (not Terminated) and (counter < NumberOfAllocations) do
begin
if FPopper then
begin
if FDestination.Count > 0 then
begin
if FDestination.Pop(TObject(p)) then
begin
Dispose(p);
inc(counter);
end;
end;
end
else
begin
if p = nil then
New(p);
if FDestination.Push(TObject(p)) then
begin
p := nil;
inc(counter);
end;
end;
if FPopper then
Sleep(PopTimeOut)
else
Sleep(PushTimeOut);
end;
ReleaseSemaphore(FFinished, 1, @temp);
end;
var
AThreadStacksTests: array[0..NumberOfThreads - 1] of TThreadStackThread;
AFreeStacksTests: array[0..NumberOfThreads - 1] of TFreeStackThread;
i, j: Integer;
Start, Stop, Freq: Int64;
ThreadStacks: array[0..1] of TThreadStack;
FreeStacks: array[0..1] of TFreeStack;
ResultThread: array[0..NumberOfTest - 1] of Double;
ResultFree: array[0..NumberOfTest - 1] of Double;
Finished: THandle;
Mean, StdDev: Extended;
begin
ThreadStacks[0] := TThreadStack.Create;
ThreadStacks[1] := TThreadStack.Create;
FreeStacks[0] := TFreeStack.Create;
FreeStacks[1] := TFreeStack.Create;
Finished := CreateSemaphore(nil, 0, NumberOfThreads, 'Thread runners');
Writeln('Starting ThreadStack threads');
for j := 0 to NumberOfTest - 1 do
begin
QueryPerformanceCounter(Start);
for I := 0 to NumberOfThreads - 1 do
AThreadStacksTests[i] := TThreadStackThread.Create(ThreadStacks[i mod 2], (i mod 4) >= 2, Finished);
for I := 0 to NumberOfThreads - 1 do
WaitForSingleObject(Finished, INFINITE);
QueryPerformanceCounter(Stop);
for I := 0 to NumberOfThreads - 1 do
AThreadStacksTests[i].Free;
ResultThread[j] := Stop - Start;
end;
Writeln('ThreadStack done.');
Writeln('Starting TFreeStack threads');
for j := 0 to NumberOfTest - 1 do
begin
QueryPerformanceCounter(Start);
for I := 0 to NumberOfThreads - 1 do
AFreeStacksTests[i] := TFreeStackThread.Create(FreeStacks[i mod 2], (i mod 4) >= 2, Finished);
for I := 0 to NumberOfThreads - 1 do
WaitForSingleObject(Finished, INFINITE);
QueryPerformanceCounter(Stop);
for I := 0 to NumberOfThreads - 1 do
AFreeStacksTests[i].Free;
ResultFree[j] := Stop - Start;
end;
Writeln('TFreeStack done.');
Writeln(Format('Calculating the mean and the standard deviation out of %d runs.', [NumberOfTest]));
QueryPerformanceFrequency(Freq);
MeanAndStdDev(ResultThread, Mean, StdDev);
Writeln(Format('TThreadStack: %f (%f)', [Mean, StdDev]));
Writeln(Format('TThreadStack: %fms (%fms)', [Mean / (Freq / 1000), StdDev / (Freq / 1000)]));
MeanAndStdDev(ResultFree, Mean, StdDev);
Writeln(Format('TFreeStack: %f (%f)', [Mean, StdDev]));
Writeln(Format('TFreeStack: %fms (%fms)', [Mean / (Freq / 1000), StdDev / (Freq / 1000)]));
if DebugHook <> 0 then
Readln;
{ freeing everything}
ThreadStacks[0].Free;
ThreadStacks[1].Free;
FreeStacks[0].Free;
FreeStacks[1].Free;
CloseHandle(Finished);
end.
This one also creates the memory leak. Running the code on a P4 2.26 returns this result:
Starting ThreadStack threads
ThreadStack done.
Starting TFreeStack threads
TFreeStack done.
Calculating the mean and the standard deviation out of 10 runs.
TThreadStack: 7152374,20 (26574,65)
TThreadStack: 1998,12ms (7,42ms)
TFreeStack: 7339945,80 (310570,01)
TFreeStack: 2050,52ms (86,76ms)
So the TFreestack is all most the same speed as the simple critical section based TThreadStack, although I know now the test isn't what you'd call regular, because it's constantly trying to push and pop. So perhaps a more normal situation would result differently. But in my program this situation was expected.
I also liked the simplicity of the TThreadStack above the complexity of the FreeStack, were you had to compile a piece TASM (containing the CAS) for it to work. Another show stopper was the memory leak. But actually I just wanted to post my simple TThreadStack so that next time I have to use it, I can just wander to my own blog. So without further ado, I bring you the following source.
unit unThreadStack;
interface
uses
Windows, Contnrs;
type
TStack = Contnrs.TStack;
TThreadStack = class
private
FStack: TStack;
FLock :TRTLCriticalSection;
public
constructor Create();
destructor Destroy; override;
function LockStack : TStack;
procedure UnlockStack;
function Count: Integer;
function Push(AItem: Pointer): Pointer;
function Pop: Pointer;
function Peek: Pointer;
end;
implementation
{ TThreadStack }
function TThreadStack.LockStack: TStack;
begin
EnterCriticalSection(FLock);
Result := FStack;
end;
function TThreadStack.Count: Integer;
begin
EnterCriticalSection(FLock);
try
Result := FStack.Count;
finally
LeaveCriticalSection(FLock);
end;
end;
constructor TThreadStack.Create();
begin
inherited Create();
InitializeCriticalSection(FLock);
FStack := Contnrs.TStack.Create;
end;
destructor TThreadStack.Destroy;
begin
DeleteCriticalSection(FLock);
FStack.Free;
inherited;
end;
function TThreadStack.Peek: Pointer;
begin
EnterCriticalSection(FLock);
try
Result := FStack.Peek;
finally
LeaveCriticalSection(FLock);
end;
end;
function TThreadStack.Pop: Pointer;
begin
EnterCriticalSection(FLock);
try
Result := FStack.Pop;
finally
LeaveCriticalSection(FLock);
end;
end;
function TThreadStack.Push(AItem: Pointer): Pointer;
begin
EnterCriticalSection(FLock);
try
Result := FStack.Push(AItem);
finally
LeaveCriticalSection(FLock);
end;
end;
procedure TThreadStack.UnlockStack;
begin
LeaveCriticalSection(FLock);
end;
end.
If you use this source, I would like it if you just left a comment on this blog.
Tags: delphi, multithreading, stack
