ezdslskp.pas

Eazy Data Structures library for Delphi.

{--------}
procedure TSkipList.Insert(var Cursor : TListCursor; aData : pointer);
var
  Walker    : PNode;
  NextStep  : TListCursor;
  TempNode  : PNode;
  Level     : integer;
  CompResult: integer;
  PrevLink  : array [0..pred(skMaxLevels)] of PNode;
begin
  {$IFDEF SuppressWarnings}
  CompResult := 0;
  {$ENDIF}
  Walker := PNode(SetBeforeFirst);
  {note: the following for loop is executed at least once
         because skCurLevels >= 1}
  for Level := pred(skCurLevels) downto 0 do begin
    NextStep := TListCursor(Walker^.FwLink[Level]);
    if IsAfterLast(NextStep) then
      CompResult := -1
    else
      CompResult := Compare(aData, Examine(NextStep));
    while (CompResult > 0) do begin
      Walker := PNode(NextStep);
      NextStep := TListCursor(Walker^.FwLink[Level]);
      if IsAfterLast(NextStep) then
        CompResult := -1
      else
        CompResult := Compare(aData, Examine(NextStep));
    end;
    PrevLink[Level] := Walker;
  end;
  {Note: Delphi warns that CompResult might not have been initialized.
         Wrong, the above loop is performed at least once}
  if (CompResult = 0) then
    RaiseError(escInsertDup);
  Level := 1;
  while (Level < skMaxLevels) and (skRandGen.RandomByte < 64) do
    inc(Level);
  if (Level > skCurLevels) then begin
    PrevLink[skCurLevels] := skBF;
    inc(skCurLevels);
    Level := skCurLevels;
  end;
  skNewNodeLevel := Level;
  TempNode := acNewNode(aData);
  for Level := pred(skNewNodeLevel) downto 0 do
    with PrevLink[Level]^ do begin
      TempNode^.FwLink[Level] := FwLink[Level];
      FwLink[Level] := TempNode;
    end;
  with TempNode^.FwLink[0]^ do begin
    TempNode^.BkLink := BkLink;
    BkLink := TempNode;
  end;
  Cursor := TListCursor(TempNode);
end;
{--------}
function TSkipList.IsAfterLast(Cursor : TListCursor) : boolean;
begin
  Result := (PNode(Cursor) = skAL);
end;
{--------}
function TSkipList.IsBeforeFirst(Cursor : TListCursor) : boolean;
begin
  Result := (PNode(Cursor) = skBF);
end;
{--------}
function TSkipList.Iterate(Action : TIterator; Backwards : boolean;
                            ExtraData : pointer) : pointer;
var
  Walker : TListCursor;
begin
  if Backwards then begin
    Walker := Prev(SetAfterLast);
    while not IsBeforeFirst(Walker) do begin
      if Action(Self, Examine(Walker), ExtraData) then
        Walker := Prev(Walker)
      else begin
        Result := Examine(Walker);
        Exit;
      end;
    end;
  end
  else {not Backwards} begin
    Walker := Next(SetBeforeFirst);
    while not IsAfterLast(Walker) do begin
      if Action(Self, Examine(Walker), ExtraData) then
        Walker := Next(Walker)
      else begin
        Result := Examine(Walker);
        Exit;
      end;
    end;
  end;
  Result := nil;
end;
{--------}
procedure TSkipList.Join(List : TSkipList);
var
  Dummy,
  Walker : TListCursor;
  Data   : pointer;
begin
  if not Assigned(List) then Exit;

  {$IFDEF DEBUG}
  EZAssert(List.IsDataOwner = IsDataOwner, ascCannotJoinData);
  {$ENDIF}

  if not List.IsEmpty then begin
    Walker := List.Next(List.SetBeforeFirst);
    while not List.IsAfterLast(Walker) do begin
      Data := List.Examine(Walker);
      Walker := List.Delete(Walker);
      Insert(Dummy, Data);
    end;
  end;
  List.Free;
end;
{--------}
function TSkipList.Next(Cursor : TListCursor) : TListCursor;
begin
  {$IFDEF DEBUG}
  EZAssert(not IsAfterLast(Cursor), ascAlreadyAtEnd);
  {$ENDIF}
  Result := TListCursor(PNode(Cursor)^.FwLink[0]);
end;
{--------}
function TSkipList.Prev(Cursor : TListCursor) : TListCursor;
begin
  {$IFDEF DEBUG}
  EZAssert(not IsBeforeFirst(Cursor), ascAlreadyAtStart);
  {$ENDIF}
  Result := TLIstCursor(PNode(Cursor)^.BkLink);
end;
{--------}
function TSkipList.Replace(Cursor : TListCursor; aData : pointer) : pointer;
begin
  {$IFDEF DEBUG}
  EZAssert((not IsBeforeFirst(Cursor)) and (not IsAfterLast(Cursor)), ascReplaceEdges);
  {$ENDIF}
  Result := Examine(Cursor);
  Cursor := Delete(Cursor);
  Insert(Cursor, aData);
end;
{--------}
function TSkipList.Search(var Cursor : TListCursor; aData : pointer) : boolean;
var
  Walker    : PNode;
  NextStep  : TListCursor;
  Level     : integer;
  CompResult: integer;
begin
  {$IFDEF SuppressWarnings}
  NextStep := 0;
  CompResult := 0;
  {$ENDIF}
  Walker := PNode(SetBeforeFirst);
  {note: the following for loop is executed at least once
         because skCurLevels >= 1}
  for Level := pred(skCurLevels) downto 0 do begin
    NextStep := TListCursor(Walker^.FwLink[Level]);
    if IsAfterLast(NextStep) then
      CompResult := -1
    else
      CompResult := Compare(aData, Examine(NextStep));
    while (CompResult > 0) do begin
      Walker := PNode(NextStep);
      NextStep := TListCursor(Walker^.FwLink[Level]);
      if IsAfterLast(NextStep) then
        CompResult := -1
      else
        CompResult := Compare(aData, Examine(NextStep));
    end;
  end;
  {Note: Delphi warns that NextStep and CompResult might not have been
         initialized. Wrong, the above loop is performed at least
         once}
  Cursor := NextStep;
  Result := (CompResult = 0);
end;
{--------}
function TSkipList.SetBeforeFirst : TListCursor;
begin
  Result := TListCursor(skBF);
end;
{--------}
function TSkipList.SetAfterLast : TListCursor;
begin
  Result := TListCursor(skAL);
end;
{--------}
function TSkipList.skCloneItem(SL : TAbstractContainer;
                               aData : pointer;
                               NSL : pointer) : boolean;
var
  NewList : TSkipList absolute NSL;
  NewData : pointer;
  Dummy   : TListCursor;
begin
  Result := true;
  with NewList do begin
    if IsDataOwner then
      NewData := DupData(aData)
    else
      NewData := aData;
    try
      Insert(Dummy, NewData);
    except
      if IsDataOwner and Assigned(NewData) then
        DisposeData(NewData);
      raise;
    end;{try..except}
  end;
end;
{--------}
function TSkipList.skMergeLists(aBeforeNode1 : PNode; aCount1 : longint;
                                aBeforeNode2 : PNode; aCount2 : longint) : PNode;
var
  Last  : PNode;
  Temp  : PNode;
  Node1 : PNode;
  Node2 : PNode;
  Inx1  : longint;
  Inx2  : longint;
begin
  {Note: the way this routine is called means that the two sublists to
         be merged look like this
           BeforeNode1 -> SubList1 -> SubList2 -> rest of list
         In particular the last node of sublist2 points to the rest of
         the (unsorted) linked list.}
  {prepare for main loop}
  Last := aBeforeNode1;
  Inx1 := 0;
  Inx2 := 0;
  Node1 := aBeforeNode1^.FwLink[0];
  Node2 := aBeforeNode2^.FwLink[0];
  {picking off nodes one by one from each sublist, attach them in
   sorted order onto the link of the Last node, until we run out of
   nodes from one of the sublists}
  while (Inx1 < aCount1) and (Inx2 < aCount2) do begin
    if (Compare(Node1^.Data, Node2^.Data) <= 0) then begin
      Temp := Node1;
      Node1 := Node1^.FwLink[0];
      inc(Inx1);
    end
    else {Node1 > Node2} begin
      Temp := Node2;
      Node2 := Node2^.FwLink[0];
      inc(Inx2);
    end;
    Last^.FwLink[0] := Temp;
    Last := Temp;
  end;
  {if there are nodes left in the first sublist, merge them}
  if (Inx1 < aCount1) then begin
    while (Inx1 < aCount1) do begin
      Last^.FwLink[0] := Node1;
      Last := Node1;
      Node1 := Node1^.FwLink[0];
      inc(Inx1);
    end;
  end
  {otherwise there must be nodes left in the second sublist, so merge
   them}
  else begin
    while (Inx2 < aCount2) do begin
      Last^.FwLink[0] := Node2;
      Last := Node2;
      Node2 := Node2^.FwLink[0];
      inc(Inx2);
    end;
  end;
  {patch up link to rest of list}
  Last^.FwLink[0] := Node2;
  {return the last node}
  Result := Last;
end;
{--------}
function TSkipList.skMergeSort(aBeforeNode : PNode; aCount : longint) : PNode;
var
  Count2   : longint;
  LastNode1: PNode;
  {$IFDEF Windows}
  DummyNode: PNode;
  {$ENDIF}
begin
  {recursion terminator: if there's only one thing to sort we're
   already sorted <g>}
  if (aCount <= 1) then begin
    Result := aBeforeNode^.FwLink[0];
    Exit;
  end;
  {split the current sublist into 2 'equal' halves}
  Count2 := aCount shr 1;
  aCount := aCount - Count2;
  {mergesort the first half, save last node of sorted sublist}
  LastNode1 := skMergeSort(aBeforeNode, aCount);
  {mergesort the second half, discard last node of sorted sublist}
  {$IFDEF Windows}
  DummyNode :=
  {$ENDIF}
  skMergeSort(LastNode1, Count2);
  {merge the two sublists, and return the last sorted node}
  Result := skMergeLists(aBeforeNode, aCount, LastNode1, Count2);
end;
{--------}
function TSkipList.Split(Cursor : TListCursor) : TSkipList;
var
  NewList   : TSkipList;
  Dummy     : TListCursor;
  Data      : pointer;
begin                                                       
  {$IFDEF DEBUG}
  EZAssert((not IsBeforeFirst(Cursor)) and (not IsAfterLast(Cursor)), ascSplitEdges);
  {$ENDIF}
  NewList := TSkipList(TAbstractContainerClass(ClassType).Create(IsDataOwner));
  NewList.Compare := Compare;
  NewList.DupData := DupData;
  NewList.DisposeData := DisposeData;
  Result := NewList;

  while not IsAfterLast(Cursor) do begin
    Data := Examine(Cursor);
    Cursor := Delete(Cursor);
    NewList.Insert(Dummy, Data);
  end;
end;
{====================================================================}


{$IFDEF ThreadsExist}
{===TThreadsafeSkipList==============================================}
constructor TThreadsafeSkipList.Create(aDataOwner : boolean);
begin
  inherited Create;
  slResLock := TezResourceLock.Create;
  slSkipList := TSkipList.Create(aDataOwner);
end;
{--------}
destructor TThreadsafeSkipList.Destroy;
begin
  slSkipList.Free;
  slResLock.Free;
  inherited Destroy;
end;
{--------}
function TThreadsafeSkipList.AcquireAccess : TSkipList;
begin
  slResLock.Lock;
  Result := slSkipList;
end;
{--------}
procedure TThreadsafeSkipList.ReleaseAccess;
begin
  slResLock.Unlock;
end;
{====================================================================}
{$ENDIF}

end.