Asp Forum - My scalable MLock algorithm

aminer

5/23/2014 5:00:00 AM

Hello,

I didn't patented my scalable MLock algorithm , so
i am posting the source code on internet so that
i can have a confirmation that it's my invention.

Here is the algorithm:

{*************************************************************
* Module: Scalable lock that is FIFO fair and starvation-free
* Version: 1.1
* Author: Amine Moulay Ramdane
* Company: Cyber-NT Communications
*
* Email: aminer@videotron.ca
* Website: http://pages.videotron.c...
* Date: May 12, 2014
* Last update: May 22, 2014
*
* Copyright Â© 2013 Amine Moulay Ramdane.All rights reserved
*
*************************************************************}

unit MLock;

{$I defines.inc}

interface

{$IFDEF FPC}
{$ASMMODE intel}
{$ENDIF FPC}

uses
{$IF defined(Delphi)}
cmem,
{$IFEND}
classes;

Type

{$IFDEF CPU64}
int = int64;
Long = uint64;
{$ENDIF CPU64}
{$IFDEF CPU32}
int = integer;
Long = longword;
{$ENDIF CPU32}

typecache = array[0..13] of integer;

PInt = ^int;
PListEntry = ^TListEntry;
TListEntry = record
Next: PListEntry;
Data: Int;
end;
TMLock=Class
private
m_tail:PListEntry;
m_head:PListEntry;
flag:int;
n1:PListEntry;
Public
count1:Integer;
constructor create;
destructor Destroy; override;
procedure Enter;
procedure Leave;
end;

function LockedExchange(var Target: long; Value: long): long;

implementation

uses SysUtils;

{$IF defined(CPU64) }
function LockedCompareExchange(CompareVal, NewVal: Int; var Target:
int): Int; overload;
asm
mov rax, rcx
lock cmpxchg [r8], rdx
end;
{$IFEND}
{$IF defined(CPU32) }
function LockedCompareExchange(CompareVal, NewVal: int; var Target:
int): int; overload;
asm
lock cmpxchg [ecx], edx
end;
{$IFEND}

function CAS(var Target:int;Comp ,Exch : int): boolean;
var ret:int;
begin

ret:=LockedCompareExchange(Comp,Exch,Target);
if ret=comp
then result:=true
else result:=false;

end; { CAS }

function LockedExchange(var Target: long; Value: long): long;
asm
{$IFDEF CPU32}
// --> EAX Target
// EDX Value
// <-- EAX Result
MOV ECX, EAX
MOV EAX, EDX
// ECX Target
// EAX Value
LOCK XCHG [ECX], EAX
{$ENDIF CPU32}
{$IFDEF CPU64}
// --> RCX Target
// RDX Value
// <-- RAX Result
MOV RAX, RDX
// RCX Target
// RAX Value
LOCK XCHG [RCX], RAX
{$ENDIF CPU64}
end;

constructor TMLock.create;

begin
new(n1);
n1^.Data:=0;
n1^.Next:=nil;
m_tail:=n1;
m_head:=n1;
flag:=1;
end;

destructor TMLock.Destroy;
begin
dispose(n1);
inherited Destroy;

end;

procedure TMLock.Enter;
var n,prev:PListEntry;
k:integer;

begin

new(n);
n^.Data:=0;
n^.Next:=nil;

long(prev) := LockedExchange(long(m_head), long(n));

prev.next := n;

if (flag=1)
then
begin
if (m_tail=prev)
then
if CAS(flag,1,0)
then
begin
n^.Data:=-1;
exit;
end;
end;
k:=1;
repeat

if n^.data=1
then
begin
dispose(n);
//n^.Data:=-1;
break;
end
else if n^.data=2
then
begin
n^.Data:=-1;
break
end;
if (flag=1)
then
begin
if (m_tail.next.next=n)
then
if CAS(flag,1,0)
then
begin
n^.Data:=-1;
break;
end;
end;
inc(k);
if (k mod 140)=0
then
{$IFDEF FPC}
ThreadSwitch;
{$ENDIF}
{$IFDEF Delphi}
sleep(0);
{$ENDIF}
asm pause end;
until false;

end;

procedure TMLock.Leave;
var next:PListEntry;
i:integer;
begin

repeat
next := m_tail.next;

if (next = nil)
then
begin
flag:=1;
exit;
end
else if (next.data=0)
then
begin

if next.next<>nil
then
begin
m_tail.next:=next.next;
next.data:=1;
//dispose(next);
exit;
end
else
begin
next.data:=2;
exit;
end;

end
else if next.data=-1
then
begin
if next.next<>nil
then
begin
m_tail.next:=next.next;
dispose(next);
end
else
begin
flag:=1;
exit;
end;
end;
until false;

end;

end.

===

comp.programming

My scalable MLock algorithm

aminer

x Login to ForumsZone