Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.

Dismiss

Lock-free datastructures...

45 views

Skip to first unread message

R.Amine

unread,

Sep 20, 2006, 10:39:05 AM9/20/06

Hello ,

As i PROMISED , the lock-free Stack is NOW FINISHED.

Here is all the source code and some questions will follow.

You have to compile it with FreePascal(using ppc386 -Sd...) and
link it with ac_i686_mingw.o that you will find inside APPCore.

And for Delphi you have to compile ac_i686_tasm.asm into
an obj with tasm32.exe :
( i will upload it also in some webpages, with some stats like:
average read/writes per unit of time... and as soon as i finish
the lock-free queue, and lock-free priority queue i will upload
them also )

First, you have the ac_i686_tasm.asm after that isynch.pas,
after that the freelist.pas, and the freestack.pas:

1162 lines of source code, just cut and they will compile without any
problem.

//################################################
.586
.MODEL FLAT, C
.CODE
PUBLIC np_ac_i686_atomic_dwcas_fence
PUBLIC ac_i686_atomic_cas_fence
align 16
np_ac_i686_atomic_dwcas_fence PROC
push esi
push ebx
mov esi, [esp + 16]
mov eax, [esi]
mov edx, [esi + 4]
mov esi, [esp + 20]
mov ebx, [esi]
mov ecx, [esi + 4]
mov esi, [esp + 12]
lock cmpxchg8b qword ptr [esi]
jne np_ac_i686_atomic_dwcas_fence_fail
xor eax, eax
pop ebx
pop esi
ret
np_ac_i686_atomic_dwcas_fence_fail:
mov esi, [esp + 16]
mov [esi + 0], eax;
mov [esi + 4], edx;
mov eax, 1
pop ebx
pop esi
ret
np_ac_i686_atomic_dwcas_fence ENDP

align 16
ac_i686_atomic_xchg_fence PROC
mov ecx, [esp + 4]
mov eax, [esp + 8]
xchg [ecx], eax
ret
ac_i686_atomic_xchg_fence ENDP

align 16
ac_i686_atomic_xadd_fence PROC
mov ecx, [esp + 4]
mov eax, [esp + 8]
lock xadd [ecx], eax
ret
ac_i686_atomic_xadd_fence ENDP

align 16
ac_i686_atomic_inc_fence PROC
mov ecx, [esp + 4]
mov eax, 1
lock xadd [ecx], eax
inc eax
ret
ac_i686_atomic_inc_fence ENDP

align 16
ac_i686_atomic_dec_fence PROC
mov ecx, [esp + 4]
mov eax, -1
lock xadd [ecx], eax
dec eax
ret
ac_i686_atomic_dec_fence ENDP

align 16
ac_i686_atomic_cas_fence PROC
mov ecx, [esp + 4]
mov eax, [esp + 8]
mov edx, [esp + 12]
lock cmpxchg [ecx], edx
ret
ac_i686_atomic_cas_fence ENDP

END

//###################################################################

//#########################################################
//# Module: Sychronization primitives
//# Author: Amine Moulay Ramdane
//# Phone: (514)485-6659
//# Email: ami...@colba.net
//# Website:
//#
//# Copyright ÷ 2006 Amine Moulay Ramdane.All rights reserved
//#
//##########################################################

unit iSynch;
{ Release 1.0 -Bug Fixes and Enhancements Beta #1
Bug Fixes
---------
[] No bugs identified yet.
Enhancements
------------
[Id - Date]
[100004 - 11/1/2005 ] Added a TCritSync Class
[100005 - 11/3/2005 ] Added a TInterlockSync Class
[100006 - 11/3/2005 ] Made TInterlockSync inherit from TCritSync and
EnterCriticalSection(),EnterCriticalSection()
'virtual' methods
}
{$IFDEF FreePascal}{$ALIGN 4}{$ENDIF}
{$IFDEF FreePascal}{$L ac_i686_mingw.o}{$ENDIF}
{$IFDEF Delphi}{$L ac_i686_tasm.obj}{$ENDIF}
interface
uses
//{$IFDEF Delphi}BucketMem,
{$IFDEF Delphi}BucketMem,Windows,{$ENDIF}
//,HighResTimer,{$ENDIF}
{$IFDEF FreePascal}Windows,{$ENDIF}
SysUtils,Classes;

Const ctfree = 0 ;
ctbusy = 1 ;
INTERLOCK_OUT_OF_RANGE_MAX=127;
INTERLOCK_OUT_OF_RANGE_MIN=-128;
Type
TCritSync = class;
TInterlockSync = class;
TThreadId = class
i:integer;
end;

TCritSync = class(TObject)
private
V:dword;
Guards:dword;
//counter1,counter2:dword;
highestpriority:integer;
refcount:dword;
CurrentThreadID:dword;
protected
public
i:integer;
constructor Create;
destructor Destroy;
function TestNSet(var STATE:dword):byte;stdcall;
function CAS(var
Destination:dword;Comperand,Exchange:dword):boolean;stdcall;
function CAS2(destination,comperand,exchange:pointer):boolean;stdcall;
function CAS1(var
Destination:dword;Comperand,Exchange:dword):boolean;stdcall;
{$IFDEF FreePascal}
Function CAS64(destination,comperand,exchange:pointer):boolean;stdcall;
{$ENDIF}
procedure EnterCriticalSection;virtual;stdcall;
procedure LeaveCriticalSection;virtual;stdcall;

published
// property Priority:enumPriority read FPriority write SetPriority default
tpREALTIME;//THREAD_PRIORITY_HIGHEST;
end;
TInterlockSync = class(TCritSync)
private
//CritSyncObj: TCritSync;
// Guards:longint;

protected
public
constructor Create;
destructor Destroy;
Function InterlockedIncrement(var sNum32:longint):shortint;stdcall;
Function InterlockedDecrement(var sNum32:longint):shortint;stdcall;
Function InterlockedIncrement64(var sNum64:int64):shortint;stdcall;
Function InterlockedDecrement64(var sNum64:int64):shortint;stdcall;
published
// property Priority:enumPriority read FPriority write SetPriority default
end;
implementation
{$IFDEF FreePascal}
function
np_ac_i686_atomic_dwcas_fence(pDest,pComp,pExg:pointer):integer;cdecl;extern
al;
{$ENDIF}
{$IFDEF Delphi}
function
_np_ac_i686_atomic_dwcas_fence(pDest,pComp,pExg:pointer):integer;cdecl;exter
nal;
function
_ac_i686_atomic_cas_fence(pDest:pointer;pComp,pExg:dword):integer;cdecl;exte
rnal;
{$ENDIF}

Function TInterlockSync.InterlockedIncrement(var
sNum32:integer):shortint;stdcall;
asm
@@1: MOV EDX,1
MOV EDX,[EBP+$08]; // obj's VMT
MOV EBX,[EDX+$08]; // obj.guards
XCHG EBX,EDX
OR EDX,EDX
MOV EDI, sNum32
JNZ @@2
MOV ECX,INTEGER PTR [EDI]
INC ECX
MOV INTEGER PTR [EDI], ECX
MOV EBX,EDX
CMP ECX,0
JL @@NEGATIVE
JG @@POSITIVE
JE @@ZERO
CMP ECX,2147483647
JE @@OUT_OF_RANGE_MAX
CMP ECX,-2147483648
JE @@OUT_OF_RANGE_MIN
//OR ECX,ECX
@@2: PUSH 0
CALL Sleep
JMP @@1
@@NEGATIVE:
MOV AL,-1
JMP @@EXIT;
@@POSITIVE:
MOV AL,1
JMP @@EXIT
@@ZERO:
MOV AL,0
JMP @@EXIT
@@OUT_OF_RANGE_MIN:
MOV AL,-128
JMP @@EXIT
@@OUT_OF_RANGE_MAX:
MOV AL,127
@@EXIT:
end;

Function TInterlockSync.InterlockedDecrement(var
sNum32:integer):shortint;stdcall;
asm
@@1: MOV EDX,1
MOV EDX,[EBP+$08]; // obj's VMT
MOV EBX,[EDX+$08]; // obj.guards
XCHG EBX,EDX
OR EDX,EDX
MOV EDI, sNum32
JNZ @@2
MOV ECX,INTEGER PTR [EDI]
DEC ECX
MOV INTEGER PTR [EDI], ECX
MOV EBX,EDX

CMP ECX,0
JL @@NEGATIVE
JG @@POSITIVE
JE @@ZERO
CMP ECX,2147483647
JE @@OUT_OF_RANGE_MAX
CMP ECX,-2147483648
JE @@OUT_OF_RANGE_MIN
//OR ECX,ECX
@@2: PUSH 0
CALL Sleep
JMP @@1
@@NEGATIVE:
MOV AL,-1
JMP @@EXIT;
@@POSITIVE:
MOV AL,1
JMP @@EXIT
@@ZERO:
MOV AL,0
JMP @@EXIT
@@OUT_OF_RANGE_MIN:
MOV AL,-128
JMP @@EXIT
@@OUT_OF_RANGE_MAX:
MOV AL,127
@@EXIT:
end;

Function TInterlockSync.InterlockedIncrement64(var
sNum64:int64):shortint;stdcall;
Begin
//CritSyncObj.EnterCriticalSection;
EnterCriticalSection;
inc(sNum64);
//CritSyncObj.LeaveCriticalSection;
LeaveCriticalSection;
End;

Function TInterlockSync.InterlockedDecrement64(var
sNum64:int64):shortint;stdcall;
Begin
//CritSyncObj.EnterCriticalSection;
EnterCriticalSection;
dec(sNum64);
//CritSyncObj.LeaveCriticalSection;
LeaveCriticalSection;
End;
constructor TInterlockSync.Create;
begin
inherited Create;
Guards:=0;
//CritSyncObj:=TCritSync.create(nil);
end;
destructor TInterlockSync.Destroy;
begin
// CritSyncObj.free;
inherited Destroy;
end;

{$IFDEF FreePascal}
Function
TCritSync.CAS64(destination,comperand,exchange:pointer):boolean;stdcall;
{ EAX
EDX
ECX
}
//var ret:dword;
//Begin
//cmpxchg8b ax, mem64
//This instruction compares the 64 bit value in edx:eax with the memory
//value. If they are equal, the Pentium stores ecx:ebx into the memory
//location, otherwise it loads edx:eax with the memory location. This
//instruction sets the zero flag according to the result. It does not
//affect any other flags.
ASM
mov esi,comperand
mov edi,exchange
mov eax,[esi]
mov edx,[esi+4]
mov ebx,[edi]
mov ecx,[edi+4]
mov esi,destination
lock CMPXCHG8B [esi]
JNZ @@2
MOV AL,01
JMP @@Exit
@@2:
XOR AL,AL
@@Exit:
End;
{$ENDIF}
Function
TCritSync.CAS2(destination,comperand,exchange:pointer):boolean;stdcall;
Begin
{$IFDEF FreePascal}
//EnterCriticalSection;
result:=np_ac_i686_atomic_dwcas_fence(destination,comperand,exchange)=0;
//LeaveCriticalSection;
{$ENDIF}
{$IFDEF Delphi}
//EnterCriticalSection;
result:=_np_ac_i686_atomic_dwcas_fence(destination,comperand,exchange)=0;
//LeaveCriticalSection;
{$ENDIF}
End;
Function TCritSync.CAS(var
Destination:dword;Comperand,Exchange:dword):boolean;stdcall;
{ EAX
EDX
ECX
}
begin
{$IFDEF Delphi}
//EnterCriticalSection;
result:=_ac_i686_atomic_cas_fence(@destination,comperand,exchange)<>destinat
ion;
//LeaveCriticalSection;
{$ENDIF}
{$IFDEF FreePascal}
ASM
MOV EAX, Comperand
MOV EDI, Destination
MOV EBX,Exchange
LOCK CMPXCHG DWORD PTR [EDI],EBX
JNZ @@2
MOV AL,01
JMP @@Exit
@@2:
XOR AL,AL
@@Exit:
End;
{$ENDIF}
end;

Function TCritSync.CAS1(var
Destination:dword;Comperand,Exchange:dword):boolean;stdcall;
{ EAX
EDX
ECX
}
//var ret:dword;
//Begin
//asm
//mov edx,[ebp+$08];
//mov eax,[edx];
//mov ebx,00000007;
//mov [edx+$08],ebx;
//end;
ASM
@@1: MOV EDX,1
MOV EDX,[EBP+$08]; // obj's VMT
MOV EBX,[EDX+$08]; // obj.guards
XCHG EBX,EDX
OR EDX,EDX
JNZ @@3
MOV ECX,[EBP+$0C] // destination's address -> ecx
MOV ECX,[ECX]
CMP ECX,[EBP+$10] // compare comperand to destination
JE @@2 // jump to @@2 if equal
XOR al,al // result <- 0
JMP @@Exit
@@2:MOV EDI,Destination
MOV EAX, Exchange
MOV DWORD PTR [edi],EAX
MOV EBX,EDX
MOV al,01 // result:=1
JMP @@Exit
@@3: PUSH 0
CALL Sleep
JMP @@1
@@Exit:
END;
//result:=true;
//End;

Function TCritSync.TestNSet(var STATE:dword):byte;stdcall;
//var dest:dword;
//Begin
asm
MOV EDI, [EBP+$0C]
//STATE
//LOCK // LOCK# signal is asserted during the (BTS) instruction that
follows.
// In an SMP(x86) achitecture the CPU that executes the TestNSet has
// "exclusive" use of the STATE memory location
LOCK BTS DWORD PTR [edi],0 // copy bit 0 to CF(carry flag) & set bit 0 to 1
SETB @result // set @result to 1 if CF(carry flag) is 1
end;
//End;
//Procedure TCritSync.EnterCriticalSection;stdcall;
//Begin
// Repeat
//SetThreadPriority(getCurrentThread,0);
//sleep(0);
//Until TestNSet(self.V) = ctfree; //for TestNSet
//Until CAS(self.guards,0,1);
//SetThreadPriority(getCurrentThread,self.highestpriority+1); // to avoid
priority inversion
//End;

Procedure TCritSync.EnterCriticalSection;stdcall;
Begin
if CAS(self.CurrentThreadID,GetCurrentThreadID,self.CurrentThreadID)
then
Begin
SetThreadPriority(getCurrentThread,self.highestpriority+1);
inc(self.refcount);
end
else
Begin
//repeat
SetThreadPriority(getCurrentThread,0);
while not(CAS(self.refcount,0,1))
do
begin
sleep(0);
// until CAS(self.refcount,0,1);
end;
SetThreadPriority(getCurrentThread,self.highestpriority+1); // to avoid
priority inversion
self.currentThreadID:=GetCurrentThreadID;
End;
End;

Procedure TCritSync.LeaveCriticalSection;stdcall;
Begin
//SetThreadPriority(getCurrentThread,self.highestpriority);
// self.V:=ctfree;
// self.guards:=0
case self.refcount of
1: Begin
dec(self.refcount);
if (refcount)=0
then
begin
self.CurrentThreadID:=0;
SetThreadPriority(getCurrentThread,self.highestpriority);
end;
End;
2..Maxint: dec(self.refcount);
//SetThreadPriority(getCurrentThread,self.highestpriority+1);
end;
//SetThreadPriority(getCurrentThread,0);
//sleep(0);
End;

constructor TCritSync.Create;
begin
// {$IFDEF Delphi}ismultithread:=true;{$ENDIF}
inherited Create;
self.V:=ctfree;
self.Guards:=0;
self.refcount:=0;
self.CurrentThreadID:=0;
// self.counter:=0;
self.highestpriority:=1;
end;
destructor TCritSync.Destroy;
begin
inherited Destroy;
end;
end.

//###################################################################
unit FreeList;
interface
uses
{$IFDEF Delphi}BucketMem,Windows,{$ENDIF}
isynch;

type
{$IFDEF FreePascal}
DWORD = Longword;
{$ENDIF}
// Note: TSingleLinkNode must be a class since Delphi will ensure
// that instances are on a 32-bit boundary and this is required
// for the CAS operator.
TSingleLinkNode = class
private
protected
InUse : LongBool; // must be 32-bit boolean
Next : TSingleLinkNode;
public
myObject : TObject;
end;
TFreeList = class
private
FHead : TSingleLinkNode;
FCount : integer;
CritSyncObj: TCritSync;
protected
function acquireNewPointer : TSingleLinkNode;
function acquireUnusedPointer : TSingleLinkNode;
procedure incrementCount;
public
constructor Create;
destructor Destroy; override;
function Count : integer;
function Acquire : TSingleLinkNode;
procedure Release(myPtr : TSingleLinkNode);
function Contains(myObject : TObject) : boolean;
end;
{$IFDEF Delphi}
function CASInteger(var Destination : integer;
Comparand : integer;
Exchange : integer) : boolean;
function CASPointer(var Destination : pointer;
Comparand : pointer;
Exchange : pointer) : boolean;
{$ENDIF}
implementation
{====================================================================}
{$IFDEF Delphi}
function CASInteger(var Destination : integer;
Comparand : integer;
Exchange : integer) : boolean;
var
Original : pointer;
begin
Original := InterlockedCompareExchange(pointer(Destination),
pointer(Exchange),
pointer(Comparand));
Result := integer(Original) = Comparand;
end;
function CASPointer(var Destination : pointer;
Comparand : pointer;
Exchange : pointer) : boolean;
var
Original : pointer;
begin
Original := InterlockedCompareExchange(Destination,
Exchange,
Comparand);
Result := Original = Comparand;
end;

{$ENDIF}
{====================================================================}

{====================================================================}
constructor TFreeList.Create;
begin
inherited Create;
FHead := TSingleLinkNode.Create;
self.CritSyncObj:=TCritSync.Create;
end;
{--------}
destructor TFreeList.Destroy;
var
Walker, Temp : TSingleLinkNode;
begin
Walker := FHead;
while (Walker <> nil) do begin
Temp := Walker;
Walker := Temp.Next;
Temp.Free;
end;
CritSyncObj.free;
inherited Destroy;
end;
{--------}
function TFreeList.Acquire : TSingleLinkNode;
begin
Result := acquireUnusedPointer;
if (Result = nil) then
Result := acquireNewPointer;
end;
{--------}
function TFreeList.acquireNewPointer : TSingleLinkNode;
var
FirstPtr : TSingleLinkNode;
begin
incrementCount;
Result := TSingleLinkNode.Create;
Result.InUse := true;
repeat
FirstPtr := FHead.Next;
Result.Next := FirstPtr;
{$IFDEF Delphi}
until CASPointer(pointer(FHead.Next), FirstPtr, Result);
{$ENDIF}
{$IFDEF FreePascal}
until Self.CritSyncObj.CAS(dword(FHead.Next), dword(FirstPtr),
dword(Result));
{$ENDIF}
end;
{--------}
function TFreeList.acquireUnusedPointer : TSingleLinkNode;
begin
Result := FHead.Next;
while (Result <> nil) do begin
if (not Result.InUse) then
{$IFDEF Delphi}
if CASInteger(integer(Result.InUse),
integer(LongBool(false)),
integer(LongBool(true))) then
{$ENDIF}
{$IFDEF FreePascal}
if Self.CritSyncObj.CAS(dword(Result.InUse),
dword(LongBool(false)),
dword(LongBool(true))) then
{$ENDIF}
Exit;
Result := Result.Next;
end;
end;
{--------}
function TFreeList.Contains(myObject : TObject) : boolean;
var
Walker : TSingleLinkNode;
begin
Result := true;
Walker := FHead.Next;
while (Walker <> nil) do begin
if (Walker.myObject = myObject) then
Exit;
Walker := Walker.Next;
end;
Result := false;
end;
{--------}
function TFreeList.Count : integer;
begin
Result := FCount;
end;
{--------}
procedure TFreeList.incrementCount;
var
OldCount : integer;
begin
repeat
OldCount := FCount;
{$IFDEF Delphi}
until CASInteger(FCount, OldCount, OldCount + 1);
{$ENDIF}
{$IFDEF FreePascal}
until Self.CritSyncObj.CAS(dword(FCount), dword(OldCount), dword(OldCount +
1));
{$ENDIF}
end;
{--------}
procedure TFreeList.Release(myPtr : TSingleLinkNode);
begin
myPtr.myObject := nil;
myPtr.InUse := false;
end;
{====================================================================}
end.
//###################################################################
//#########################################################
//# Module: Lock-free Stack
//# Author: Amine Moulay Ramdane
//# Phone: (514)485-6659
//# Email: ami...@colba.net
//# Website:
//#
//# Copyright ÷ 2006 Amine Moulay Ramdane.All rights reserved
//#
//##########################################################

unit FreeStack;
interface
uses
{$IFDEF Delphi}BucketMem,Windows,{$ENDIF}
isynch,freelist;

type
TSingleLnkNode = class ( TSingleLinkNode )
end;
TData64 = Record
Next:TSingleLnkNode;
OCount:integer;
End;
{$IFDEF FreePascal}
DWORD = Longword;
{$ENDIF}
// Note: TSingleLnkNode must be a class since Delphi will ensure
// that instances are on a 32-bit boundary and this is required
// for the CAS operator.
TFreeStack = class(TCritSync)
private
data1,data2,data3:^TData64; // data1:
self.fhead.Next(32bits)+FOCOUNT(32bits: push count), it's 8 bytes aligned
FHead : TSingleLnkNode;
FCount : integer;
FOcount: integer;
FreeList:TFreeList;
//VMT:pointer;
TempPointer1,TempPointer2,TempPointer3:pointer;
//CritSyncObj: TCritSync;
protected
procedure incrementCount;
procedure decrementCount;
function D_32_64(a,b:integer):int64;
function Make8ByteAligned (InVar: Pointer; InSize: Integer; var
PointerTrack: Pointer): Pointer;
function getVMT:pointer;
public
constructor Create;
destructor Destroy;
function Count : integer;
function Push(myObject:TObject):boolean;
function Pop(var myObject:TObject):boolean;
end;
{$IFDEF Delphi}
function CASInteger(var Destination : integer;
Comparand : integer;
Exchange : integer) : boolean;
function CASPointer(var Destination : pointer;
Comparand : pointer;
Exchange : pointer) : boolean;
{$ENDIF}
//var data,data1,data2:^TData64;
// temppointer,temppointer1,temppointer2:pointer;
implementation
{====================================================================}
{$IFDEF Delphi}
function CASInteger(var Destination : integer;
Comparand : integer;
Exchange : integer) : boolean;
var
Original : pointer;
begin
Original := InterlockedCompareExchange(pointer(Destination),
pointer(Exchange),
pointer(Comparand));
Result := integer(Original) = Comparand;
end;
function CASPointer(var Destination : pointer;
Comparand : pointer;
Exchange : pointer) : boolean;
var
Original : pointer;
begin
Original := InterlockedCompareExchange(Destination,
Exchange,
Comparand);
Result := Original = Comparand;
end;

{$ENDIF}
{====================================================================}

{====================================================================}
function TFreeStack.getVMT:pointer;
asm
MOV EAX,[EBP+$08]; // obj's VMT
//MOV EAX,[EDX+$04]; // 'data' pointer that is 8 bytes aligned
end;
{====================================================================}
constructor TFreeStack.Create;
var temp:int64;
begin
inherited Create;
self.FHead := TSingleLnkNode.Create;
self.FreeList := TFreeList.Create;
//self.CritSyncObj:=TCritSync.Create;
self.fcount:=0;self.focount:=0;temp:=0;
// self.VMT:=self.getVMT();
self.data1:=Make8ByteAligned (@temp, 8, TempPointer1);
self.data2:=Make8ByteAligned (@temp, 8, TempPointer2);
self.data3:=Make8ByteAligned (@temp, 8, TempPointer3);
With data1^,data2^,data3^
do
begin
Next:=TSingleLnkNode(self.FHead.next);
OCount:=0;
end;
end;
{--------}
destructor TFreeStack.Destroy;
var myObj:TObject;
ret:boolean;
begin
repeat
ret:=self.pop(myObj);
if ret then myObj.free;
until not ret;
FreeList.free;
//CritSyncObj.free;
FreeMem(self.TempPointer1);
FreeMem(self.TempPointer2);
FreeMem(self.TempPointer3);
inherited Destroy;
end;
{--------}
function TFreeStack.Push(myObject:TObject):boolean;
var newNode: TSingleLnkNode;
begin
incrementCount;
newNode:=TSingleLnkNode(freelist.Acquire);
newNode.myObject:=myObject;
repeat
newNode.Next := TSingleLnkNode(TData64(self.data1^).next); //
self.fhead.Next;
{$IFDEF Delphi}
//Until CASPointer(pointer(self.fhead.Next), pointer(newNode.Next),
pointer(newNode));
Until CASPointer(pointer(TData64(self.data1^).next), pointer(newNode.Next),
pointer(newNode));
{$ENDIF}
{$IFDEF FreePascal}
//Until CAS(dword(self.fhead.Next), dword(newNode.Next), dword(newNode));
Until CAS(dword(TData64(self.data1^).next), dword(newNode.Next),
dword(newNode));
{$ENDIF}
result:=true;
end;
{--------}
function TFreeStack.Pop(var myObject:TObject):boolean;
var node: TSingleLnkNode;
a,b:integer;
c1,c2,c3:int64;
POPCount:integer;
begin
repeat
// node := TSingleLnkNode(self.fhead.next);
node := TSingleLnkNode(TData64(self.data1^).Next);
if node = nil
then
Begin
myObject:=nil;
result:=false;
exit;
End;
With self.data1^
do
begin
if OCount=maxint
then POPCount:=0
else POPCount:=OCount;
end;

//a:=integer(node);
//b:=integer(POPCount);
//c1:=self.D_32_64(b,a);
//a:=integer(node.next);
//b:=integer(POPCount+1);
//c2:=self.D_32_64(b,a);
With data2^
do
begin
next:= node;
OCount:=POPCount;
end;
With data3^
do
begin
next:= TSingleLnkNode(node.next);
OCount:=POPCount+1;
end;

{$IFDEF Delphi}
//Until CASPointer(pointer(self.fhead.Next), pointer(node),
pointer(node.next));
Until CAS2(data1, data2, data3);
//Until CAS64(data, c1, c2);
{$ENDIF}
{$IFDEF FreePascal}
//Until CAS(dword(self.fhead.Next), dword(node), dword(node.next));
//Until CAS2(data1, data1, data2);
Until CAS64(data1, data2, data3);
{$ENDIF}
//With data^
// do
// begin
// writeln('pop count: ',POPCount);
// end;
myObject:=node.myObject;
freelist.Release(node);
result:=true;
decrementCount;
end;
{--------}
function TFreeStack.Count : integer;
begin
Result := self.FCount;
end;
{--------}
procedure TFreeStack.incrementCount;
var
OldCount : integer;
begin
repeat
OldCount := self.FCount;
{$IFDEF Delphi}
until CASInteger(self.FCount, OldCount, OldCount + 1);
{$ENDIF}
{$IFDEF FreePascal}
until CAS(dword(self.FCount), dword(OldCount), dword(OldCount + 1));
{$ENDIF}
end;

{--------}
procedure TFreeStack.decrementCount;
var
OldCount : integer;
begin
repeat
OldCount := self.FCount;
{$IFDEF Delphi}
until CASInteger(self.FCount, OldCount, OldCount - 1);
{$ENDIF}
{$IFDEF FreePascal}
until CAS(dword(self.FCount), dword(OldCount), dword(OldCount - 1));
{$ENDIF}
end;
{====================================================================}
function TFreeStack.D_32_64(a,b:integer):int64;
begin
result := a;
result:=result shl 32;
result:=result or b;
end;
{====================================================================}
function TFreeStack.Make8ByteAligned (InVar: Pointer; InSize: Integer; var
PointerTrack: Pointer): Pointer;
// Returns an 8 byte aligned pointer to the data
var
TempData: Pointer;
Align: Integer;
begin
GetMem (TempData, InSize+8);
Align := 8 - (LongInt (TempData) and 7); // Find out how far off alignment
we are.
Move (InVar^, Pointer(LongInt(TempData)+Align)^, InSize);
// Save the original pointer so that we can free it once we are done with
the variable:
PointerTrack := TempData;
// Result:
Make8ByteAligned := Pointer (LongInt(TempData)+Align);
end;
end.

R.Amine

unread,

Sep 20, 2006, 10:43:13 AM9/20/06

And here is an object oriented example for the lock-free stack
(some other tests, that will use threads, will follow soon..)

//###############################################
program test;

uses freestack;

type
TInteger = class
private
public
i:integer;
end;

var stack:TFreeStack;
myobj1,myobj2,retObj:TInteger;
i:integer;
begin
stack:= TFreestack.create;
myobj1:=TInteger.create;
myobj1.i:=1;
stack.push(TObject(myobj1));
myobj2:=TInteger.create;
myobj2.i:=2;
stack.push(TObject(myobj2));
writeln('Stack size: ',stack.count);
for i:=0 to stack.count-1
do
begin
stack.pop(TObject(retObj));
writeln(retObj.i);
end;
//writeln(myobj1.i);
stack.free;
end.

//##########################################

R.Amine

unread,

Sep 20, 2006, 11:09:22 AM9/20/06

Hello Chriss Thomasson,

I have used the data1,data2,data3 members inside the TFreeStack object
that are pointers to struct TData64:

TData64 = Record
Next:TSingleLnkNode;
OCount:integer;
End;

and i have aligned them all to 8 bytes and used the inline assembly

TCritSync.CAS64:(inside isynch.pas) that i wrote:

{$IFDEF FreePascal}
DWORD = Longword;
{$ENDIF}
// Note: TSingleLnkNode must be a class since Delphi will ensure
// that instances are on a 32-bit boundary and this is required
// for the CAS operator.

TFreeStack = class(TCritSync)
private
data1,data2,data3:^TData64; // data1: self.fhead.Next(32bits)+

// +
// FOCOUNT(32bits: push count),
//it's 8 bytes aligned

FHead : TSingleLnkNode;
FCount : integer;
FOcount: integer;
FreeList:TFreeList;
//VMT:pointer;
TempPointer1,TempPointer2,TempPointer3:pointer;
//CritSyncObj: TCritSync;
protected
procedure incrementCount;
procedure decrementCount;
function D_32_64(a,b:integer):int64;
function Make8ByteAligned (InVar: Pointer; InSize: Integer; var
PointerTrack: Pointer): Pointer;
function getVMT:pointer;
public
constructor Create;
destructor Destroy;
function Count : integer;
function Push(myObject:TObject):boolean;
function Pop(var myObject:TObject):boolean;
end;

I think it is working.

So my question: Is it necessary to use the external assembly
(np_ac_i686_atomic_dwcas_fence or whatever ... ) ?

R.Amine

unread,

Sep 20, 2006, 11:30:24 AM9/20/06

Look inside the constructor:

//########################################

constructor TFreeStack.Create;
var temp:int64;
begin

inherited Create;

self.FHead := TSingleLnkNode.Create;
self.FreeList := TFreeList.Create;
//self.CritSyncObj:=TCritSync.Create;
self.fcount:=0;self.focount:=0;temp:=0;
// self.VMT:=self.getVMT();

self.data1:=Make8ByteAligned (@temp, 8, TempPointer1);
self.data2:=Make8ByteAligned (@temp, 8, TempPointer2);
self.data3:=Make8ByteAligned (@temp, 8, TempPointer3);

With data1^,data2^,data3^
do
begin
Next:=TSingleLnkNode(self.FHead.next);
OCount:=0;
end;
end;

//################################################

As you see the 'Next' field of data1 , a pointer to a struct: TData64
that i am aligning to 8 bytes), contains self.FHead.next.

And as i have understood it: the lock-free Stack is immune to Push().
So, IF there is a push() the pop will catch it inside "CAS64(data1, data2,
data3);"
since 'data1' contains the NEW "self.FHead.next"

And if there is a pop , we will catch it with the NEW "OCount" inside
"CAS64(data1, data2, data3);"

Right ?

Now as you have read in an other post, am i correct (or wrong)
to say:

"Chris Thomasson" <cri...@comcast.net> wrote in message
news:0PGdnUZqJM9A-JLY...@comcast.com...
> "R.Amine" <ami...@colba.net> wrote in message
> news:12gumfg...@corp.supernews.com...
> >
> > "R.Amine" <ami...@colba.net> wrote in message
> > news:12guhu3...@corp.supernews.com...
> >>
> >> Chris Thomasson wrote:
> >> > Trust me, this is the way things work wrt DWCAS and the push function
> >> > of
> >> > lifo.
> >>
> >> You are right, the lock-free Stack(LIFO) is immune to push.
> >>
> >> And if there is a pop, we will catch it with the FOCOUNT inside the
> >> destination of the 8 bytes aligned data.
> >
> >
> > And if the DWCAS fails,
> > that means another thread has succeded:
> > that's what we call forward progress.
> > Right ?
>
> wrt lock-free algorithms, yes.
>
> They basically guarantee constant forward progress of the algorithm each
> time a CAS fails...

So there is no Deadlock.

And we can say it like this: the system as a whole will forward its
execution, but waiting duration of individual threads may be substantial,
though bounded.

And what about priority inversion and lock convoy ?

Am i correct to say:

[1] Priority inversion:

Since the ressource ('the bus') is owned just for a short time
and there is no interdependant locks , there is no possibility of priority
inversion ?

[2] lock convoy (it's not so clear for me in lock-free...)

Can the system deschedule a thread even it is inside a 'lock instr' ?

Can we say it like this:

If the system may deschedule a thread , the ressource(the bus) will be free
to use,
so, there is no possibility of lock convoy ?

Amine Moulay Ramdane.

R.Amine

unread,

Sep 20, 2006, 12:07:45 PM9/20/06

I wrote:
> As i PROMISED , the lock-free Stack is NOW FINISHED...

And of course it's ABA safe.
(but if there is any problem, try to contact me by email)

And for the lock-free GC garbage collector:
i presented my ideas, and i think it will require to change the freelist.pas
to use two lock-free ABA safe stacks(like the one i have just implemented).

Regards,
Amine Moulay Ramdane.

R.Amine

unread,

Sep 20, 2006, 3:16:06 PM9/20/06

I wrote:
> data1,data2,data3:^TData64; // data1: self.fhead.Next(32bits)

> // +
> // FOCOUNT(32bits: push
count),

> // it's 8 bytes aligned

In the object data members above:
on the comments above ,
please read it "FOCOUNT(32bits: OUT count or POP count)"

Thank you.

Chris Thomasson

unread,

Sep 26, 2006, 7:29:07 PM9/26/06

I find Pascal source code a little tedious to read, however, I think I found
a potential bug in your code...

"R.Amine" <ami...@colba.net> wrote in message

news:12h2h46...@corp.supernews.com...

>
> Hello ,
>
> As i PROMISED , the lock-free Stack is NOW FINISHED.
>
> Here is all the source code and some questions will follow.
>
> You have to compile it with FreePascal(using ppc386 -Sd...) and
> link it with ac_i686_mingw.o that you will find inside APPCore.

> begin
> {$IFDEF Delphi}
> //EnterCriticalSection;

I think you have an error right here:

> result:=_ac_i686_atomic_cas_fence(@destination,comperand,exchange)<>destination;
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

You should be comparing the return value of the ac_i686_atomic_cas_fence
function to the comperand!!

I mentioned that the compare-and-swap for AppCore is as follows:

DWCAS == IBM-Style

CAS == Microsoft-Style!

So, you must use logic like this for CAS:

#define CAS ac_i686_atomic_cas_fence

static int shared = 0;

int tmp, cmp = shared;
do {
tmp = cmp;
cmp = CAS(&shared, cmp, cmp + 1);
} while(tmp != cmp);

You would use logic like this for DWCAS:

#define DWCAS np_ac_i686_atomic_dwcas_fence

static int64 shared = 0;

int64 xchg, cmp = shared;
do {
xchg = cmp + 1;
} while(DWCAS(&shared, &cmp, &xchg));

Are you taking all of this into account throughout your code?

Chris Thomasson

unread,

Sep 26, 2006, 7:42:23 PM9/26/06

"R.Amine" <ami...@colba.net> wrote in message

news:12h2isq...@corp.supernews.com...

>
> Hello Chriss Thomasson,
>
> I have used the data1,data2,data3 members inside the TFreeStack object
> that are pointers to struct TData64:

> I think it is working.
>

[...]

> So my question: Is it necessary to use the external assembly
> (np_ac_i686_atomic_dwcas_fence or whatever ... ) ?

I would prefer that you use the AppCore library. If you do copy my work into
another library, please mention my name and provide a link to my site in
your source code and documentation. Thank you.

I make use of external assembly in order to make it difficult for a C
compiler to reorder anything critical. It must treat the external unknown
call in a fairly pessimistic fashion; kind of like a basic full compiler
barrier. However, with the advent of link-time optimizations', you basically
"have to resort to decorating" your critical function declarations with
something the tells a rouge C compiler to:

<rant>

FUC%ING BACKOFF; DON'T YOU DARE MESS WITH MY HAND-CRAFTED
ASSEMBLY!!!!!!!!!!!!!

</rant>

Sorry for flying off the handle there. But...

If a C compiler reaches its dirty little hands into my hand-crafted assembly
code, and touches one damn thing... I will never use that evil piece of shit
ever again!!! I take this stuff a little to seriously... lol.

;)

Chris Thomasson

unread,

Sep 26, 2006, 7:49:22 PM9/26/06

"Chris Thomasson" <cri...@comcast.net> wrote in message

news:nP2dnfBjRb7VJYTY...@comcast.com...

> "R.Amine" <ami...@colba.net> wrote in message
> news:12h2isq...@corp.supernews.com...

> <rant>
>
> FUC%ING BACKOFF; DON'T YOU DARE MESS WITH MY HAND-CRAFTED
> ASSEMBLY!!!!!!!!!!!!!
>
> </rant>

Heck, I don't even want a compiler to look at my assembly! I bet the
compiler thinks that it can look at my externally assembled code, and
perform some magic optimizations'. The ignorant stupid ass compiler
optimizes away, and introduces a fuc%king race-condition into one of my
lock-free algorithms!! The compiler wags its tail thinking it did something
good... I would feel like punching the shi% out of it!!!

0 new messages