[2] Lock-free questions ...




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: aminer@xxxxxxxxx
//
//##########################################################


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.




.



Relevant Pages

  • Re: DOCOL in ITC Forth Engines (UK Newbie)
    ... and I am starting to think that DOCOL does to. ... mov *r5,r3 ... jmp next ... EXIT is a normal word like DUP or 2+. ...
    (comp.lang.forth)
  • DOCOL in ITC Forth Engines (UK Newbie)
    ... I have a question regarding DOCOL. ... I couldn't get things working until I realised that EXIT needed one, ... mov *r5,r3 ... jmp next ...
    (comp.lang.forth)
  • Re: Fastcode PosIEx B&V 1.1.1
    ... I2, SubStrLength, StrLength: Integer; ... Exit; ... mov edi,edx ...
    (borland.public.delphi.language.basm)
  • Lock-free datastructures...
    ... mov esi, ... {$IFDEF FreePascal} ... TSingleLinkNode must be a class since Delphi will ensure ... function CASPointer(var Destination: pointer; ...
    (comp.programming.threads)
  • Re: 8031 question
    ... AUXBUF EQU 0; TRICK - BAFER ... BUFFER EQU 100H; PREPARE FOR OUTPUT ... MOV R0,#TEMPDIV; TEMPERATURU CITA SAMO U KRUGU 1 ... JMP EQSEC; ...
    (sci.electronics.design)