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

Dismiss

Lock-free questions ...

27 views

Skip to first unread message

R.Amine

unread,

Sep 13, 2006, 2:20:08 PM9/13/06

Hello.

I am trying to implement some lock-free datastructures(freestack,freequeue,
freepriorityqueue..)
in Objectpascal(freepascal and delphi), but i am in the phase of
implementing something in the source code
to avoid the ABA problem.

First, i will post my first attempt, and in another post i will try to
detail my questions more...

So, here is the freestack source code that uses a freelist(as i said this is
my first attempt,
and the freelist iand freestack mplementation will change a little bit...)

Here it is:

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

type

{$IFDEF FreePascal}
DWORD = Longword;
{$ENDIF}

TSingleLinkNode = class
private
protected
InUse : LongBool;
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.

And the freestack unit:

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

type
TSingleLnkNode = class ( TSingleLinkNode )
end;

{$IFDEF FreePascal}
DWORD = Longword;
{$ENDIF}

TFreeStack = class

private
FHead : TSingleLnkNode;
FCount : integer;
FOcount: integer;
FreeList:TFreeList;
CritSyncObj: TCritSync;

protected
procedure incrementCount;
procedure decrementCount;
function D_32_64(a,b:integer):int64;

public
constructor Create;
destructor Destroy; override;
function Count : integer;
function Push(myObject:TObject):boolean;
function Pop(var myObject:TObject):boolean;
end;

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 TFreeStack.Create;
begin
inherited Create;
self.FHead := TSingleLnkNode.Create;
self.FreeList := TFreeList.Create;
self.CritSyncObj:=TCritSync.Create;
self.fcount:=0;
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;
inherited Destroy;
end;
{--------}

function TFreeStack.Push(myObject:TObject):boolean;
var newNode: TSingleLnkNode;
begin
incrementCount;
newNode:=TSingleLnkNode(freelist.Acquire);
newNode.myObject:=myObject;
repeat
newNode.Next := self.fhead.Next;
{$IFDEF Delphi}
Until CASPointer(pointer(self.fhead.Next), pointer(newNode.Next),
pointer(newNode));
{$ENDIF}
{$IFDEF FreePascal}
Until self.CritSyncObj.CAS(dword(self.fhead.Next), dword(newNode.Next),
dword(newNode));
{$ENDIF}
result:=true;
end;
{--------}

function TFreeStack.Pop(var myObject:TObject):boolean;

var node: TSingleLnkNode;
begin
repeat
node := TSingleLnkNode(self.fhead.next);
if node = nil
then
Begin
myObject:=nil;
result:=false;
exit;
End;
{$IFDEF Delphi}
Until CASPointer(pointer(self.fhead.Next), pointer(node),
pointer(node.next));
{$ENDIF}
{$IFDEF FreePascal}
Until self.CritSyncObj.CAS(dword(self.fhead.Next), dword(node),
dword(node.next));
{$ENDIF}

myObject:=node.myObject;
self.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 Self.CritSyncObj.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 Self.CritSyncObj.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;
{====================================================================}
end.

R.Amine

unread,

Sep 13, 2006, 2:41:20 PM9/13/06

Hello again,

Now here is an important piece of source code that the freelist and
freestack uses...
i have included my implementation and the Chris Thomasson implementation of
DWCAS
(the source code will come soon and will be free to use...), i have a little
bit modified and
compiled the ac_i686_masm.asm to ac_i686_tasm.asm to be able to staticly
compile it
with Delphi.

Also, in this source i have implemented a recursive CRITICAL_SECTION that
avoids priority inversion.(please take a look at the source code
TCritSync.LeaveCriticalSection, TCritSync.LeaveCriticalSection bellow and
tell me
what do you think ...). ..

//#########################################################
//#
//# Module: Sychronization primitives
//# Author: Amine Moulay Ramdane
//# Phone: (514)485-6659
//# Email: ami...@colba.net
//
//##########################################################

unit iSynch;

{ Release 1.0 -Bug Fixes and Enhancements Beta #1
Bug Fixes
---------

[] No bugs identified yet.
Enhancements
------------

[Id - Date]

[100004] Added a TCritSync Class
[100005] Added a TInterlockSync Class
[100006] 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_test(var
destination:int64;comperand,exchange:int64):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;
{$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}
{$ALIGN 8}
Function TCritSync.CAS64_test(var
destination:int64;comperand,exchange:int64):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
lea esi,comperand
lea 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}
result:=np_ac_i686_atomic_dwcas_fence(destination,comperand,exchange)=1;
{$ENDIF}
{$IFDEF Delphi}
result:=_np_ac_i686_atomic_dwcas_fence(destination,comperand,exchange)=1;
{$ENDIF}
End;
Function TCritSync.CAS(var
Destination:dword;Comperand,Exchange:dword):boolean;stdcall;
{ EAX
EDX
ECX
}
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;

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.

Chris Thomasson

unread,

Sep 13, 2006, 2:08:29 PM9/13/06

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

[...]

> I am trying to implement some lock-free
> datastructures(freestack,freequeue,
> freepriorityqueue..)
> in Objectpascal(freepascal and delphi), but i am in the phase of
> implementing something in the source code
> to avoid the ABA problem.

I have to admit that I am having a some trouble navigating through the code;
I am a C and assembly programmer...

However, could you point me to the exact piece of code that you think will
help you avoid the ABA problem... I can't find it right off the bat...

I noticed that you are using Windows atomic operations... You need to use
the 64-bit version of CAS (cmpxchg8b) on 32-bit systems (aka, DWCAS) in
order to avoid the ABA problem... 64-bit version of CAS is in Server 2003
IIRC...

You can also rely on GC, but IMHO, that is overkill; using GC just for the
sole purpose of avoiding ABA is a little nutty...

FWIW, here is one of my early solutions for solving the ABA problem:

http://groups.google.com/group/comp.programming.threads/browse_frm/thread/133f764f1bc0c9f4/c0eb5f08e858948f?lnk=gst&q=avoiding+ABA+with+8-bit&rnum=1#c0eb5f08e858948f

This code can use normal Windows atomic operations... No need for DWCAS
here... This uses a pointer offset trick...

read the following:

http://groups.google.com/group/comp.arch/browse_frm/thread/71f8e0094e353e5/ea5b47f3a67bdfc5?lnk=gst&q=why+do+double+wide&rnum=1#ea5b47f3a67bdfc5

You can construct DWCAS by using assembly language... Look at the first
function in the following file:

http://appcore.home.comcast.net/appcore/src/cpu/i686/ac_i686_gcc_asm.html

This is how my AppCore library accomplishes it...

http://appcore.home.comcast.net/

R.Amine

unread,

Sep 13, 2006, 3:06:32 PM9/13/06

Now, here is the compiler: http://www.freepascal.org/

You can use also use Delphi if you want ...and if you don't
have bucketmem just delete it from the source code and it will work fine...

And here is a small test that shows how to use the freestack:
:
//#############################################

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.

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

As i said before i am in the phase of implementing something in the code
to avoid the ABA problem(i will be more precise in my next posts...)

Please be patient, my questions on lock-free datastructures will follow
soon...

Chris Thomasson

unread,

Sep 13, 2006, 3:13:56 PM9/13/06

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

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

>
> Hello again,
>
> Now here is an important piece of source code that the freelist and
> freestack uses...
> i have included my implementation and the Chris Thomasson implementation
> of
> DWCAS
> (the source code will come soon and will be free to use...)

Please note that the DWCAS AppCore uses an IBM style version... That means
that if the DWCAS fails, the comprand automatically gets updated with the
new value... The functions returns zero for success and non-zero for
failure...

IBM style CAS allows you to do stuff like this:

static int shared = 0;

int local = shared;
while(CAS(&shared, &local, local + 1));

or:

struct anchor_t {
int a;
int b;
};

static anchor_t shared = {0, 0};

anchor_t xchg, local = shared;
do {
xchg.a = local.a + 1;
xchg.b = local.b + 2;
} while(DWCAS(&shared, &local, &xchg));

This simplifies programming styles wrt CAS-loops...

I need some time to look over your code...

R.Amine

unread,

Sep 13, 2006, 4:27:29 PM9/13/06

From Chris Thomasson AppCore , here is the ac_i686_tasm.asm

You can compile this with tasm32 :into ac_i686_tasm.obj and link it staticly
with Delphi OR use ac_i686_mingw.o (inside Appcore) directly with
FreePascal.

==================================
.586
.MODEL FLAT, C
.CODE

PUBLIC np_ac_i686_atomic_dwcas_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
==============================

Joe Seigh

unread,

Sep 13, 2006, 5:34:25 PM9/13/06

R.Amine wrote:
> Hello.
>
> I am trying to implement some lock-free datastructures(freestack,freequeue,
> freepriorityqueue..)
> in Objectpascal(freepascal and delphi), but i am in the phase of
> implementing something in the source code
> to avoid the ABA problem.
>

Some stuff you can look at

http://www.rdrop.com/users/paulmck/RCU/
http://www.rdrop.com/users/paulmck/RCU/RCU.bib

Also you can look the implementations of
java.util.concurrent as possible reference
implementations of some collections.

The java stuff uses implicit GC rather than
explicit PDR (PCOW Deferred Reclaimation) like
RCU or SMR hazard pointers but once you figure
out the general technique it should be apparent
where the PDR invocations go.

Try to keep your PDR as a separate api. The
code will be a lot cleaner that way.

--
Joe Seigh

When you get lemons, you make lemonade.
When you get hardware, you make software.

Chris Thomasson

unread,

Sep 13, 2006, 11:45:01 PM9/13/06

"Chris Thomasson" <cri...@comcast.net> wrote in message
news:ytCdnTrpZsSdy5XY...@comcast.com...

> "R.Amine" <ami...@colba.net> wrote in message
> news:12gggm9...@corp.supernews.com...
>>
>> Hello again,
>>
>> Now here is an important piece of source code that the freelist and
>> freestack uses...
>> i have included my implementation and the Chris Thomasson implementation
>> of
>> DWCAS
>> (the source code will come soon and will be free to use...)
>
> Please note that the DWCAS AppCore uses an IBM style version... That means
> that if the DWCAS fails, the comprand automatically gets updated with the
> new value... The functions returns zero for success and non-zero for
> failure...

To completely clarify, AppCore DWCAS uses IBM-style, and normal CAS uses
Microsoft style... Sorry I did not make the IBM version consistent
throughout out my CAS operations in general. Anyway, I have AppCore for
UltraSPARC T1, and the CAS are all IBM style... I may release it sometime...

Special notes for Alex T...

The IBM CAS does not use any memory barriers for the return value...
Dependant load ordering is the strongest guaranty you can rely upon wrt the
value returned from CAS (e.g., IBM style means comprand is updated with
returned value on failure).

;)

R.Amine

unread,

Sep 16, 2006, 2:36:32 AM9/16/06

I am still modifying a little bit the FreeStack.pas source code, to make it
ABA safe,
but of course you can modify it like this:

TFreeStack = class(TCritSync)

The object hierarchy:

TFreeStack = class(TCritSync)

TInterlockSync = class(TCritSync)

TSingleLnkNode = class ( TSingleLinkNode )

Source code bellow:

#=======================================

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

type
TSingleLnkNode = class ( TSingleLinkNode )
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
FHead : TSingleLnkNode;
FCount : integer;
FOcount: integer;
FreeList:TFreeList;

//CritSyncObj: TCritSync;

protected
procedure incrementCount;
procedure decrementCount;
function D_32_64(a,b:integer):int64;
public
constructor Create;
destructor Destroy;

implementation

//self.CritSyncObj:=TCritSync.Create;
self.fcount:=0;self.focount:=0;

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;

inherited Destroy;
end;
{--------}
function TFreeStack.Push(myObject:TObject):boolean;
var newNode: TSingleLnkNode;
begin
incrementCount;
newNode:=TSingleLnkNode(freelist.Acquire);
newNode.myObject:=myObject;
repeat
newNode.Next := self.fhead.Next;
{$IFDEF Delphi}
Until CASPointer(pointer(self.fhead.Next), pointer(newNode.Next),
pointer(newNode));
{$ENDIF}
{$IFDEF FreePascal}

Until CAS(dword(pointer(self.fhead.Next)), dword(newNode.Next),

until CAS(dword(self.FCount), dword(OldCount), dword(OldCount + 1));
{$ENDIF}
end;

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;

{-----}
end.

0 new messages