ezdsllst.pas

Eazy Data Structures library for Delphi.

        llCursor := llBF;
        acCount := 0;
      end;
    end;
  end;
  List.Free;
end;
{--------}
procedure TLinkList.llInsertBeforePrim(aData : pointer);
var
  Node : PNode;
begin
  Node := acNewNode(aData);
  Node^.Link := llCursor^.Link;
  llCursor^.Link := Node;
end;
{--------}
procedure TLinkList.llNextN(N : longint);
var
  i          : longint;
  Temp       : PNode;
  TempCursor : PNode;
begin
  TempCursor := llCursor;
  try
    for i := 1 to N do begin
      if (TempCursor = llAL) then
        RaiseError(escCannotMoveHere);
      Temp := TempCursor;
      TempCursor := llBF^.Link;
      llBF^.Link := TempCursor^.Link;
      TempCursor^.Link := Temp;
    end;
  finally
    llCursor := TempCursor;
  end;
end;
{--------}
function TLinkList.llMergeLists(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^.Link;
  Node2 := aBeforeNode2^.Link;
  {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^.Link;
      inc(Inx1);
    end
    else {Node1 > Node2} begin
      Temp := Node2;
      Node2 := Node2^.Link;
      inc(Inx2);
    end;
    Last^.Link := 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^.Link := Node1;
      Last := Node1;
      Node1 := Node1^.Link;
      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^.Link := Node2;
      Last := Node2;
      Node2 := Node2^.Link;
      inc(Inx2);
    end;
  end;
  {patch up link to rest of list}
  Last^.Link := Node2;
  {return the last node}
  Result := Last;
end;
{--------}
function TLinkList.llMergeSort(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^.Link;
    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 := llMergeSort(aBeforeNode, aCount);
  {mergesort the second half, discard last node of sorted sublist}
  {$IFDEF Windows}
  DummyNode :=
  {$ENDIF}
  llMergeSort(LastNode1, Count2);
  {merge the two sublists, and return the last sorted node}
  Result := llMergeLists(aBeforeNode, aCount, LastNode1, Count2);
end;
{--------}
procedure TLinkList.llPrevN(N : longint);
var
  i          : longint;
  Temp       : PNode;
  TempCursor : PNode;
begin
  TempCursor := llCursor;
  try
    for i := 1 to N do begin
      if (TempCursor = llBF) then
        RaiseError(escCannotMoveHere);
      Temp := TempCursor^.Link;
      TempCursor^.Link := llBF^.Link;
      llBF^.Link := TempCursor;
      TempCursor := Temp;
    end;
  finally
    llCursor := TempCursor;
  end;
end;
{--------}
procedure TLinkList.Next;
var
  Temp : PNode;
begin
  {$IFDEF DEBUG}
  EZAssert(not IsAfterLast, ascAlreadyAtEnd);
  {$ENDIF}
  Temp := llCursor;
  llCursor := llBF^.Link;
  llBF^.Link := llCursor^.Link;
  llCursor^.Link := Temp;
end;
{--------}
procedure TLinkList.Prev;
var
  Temp : PNode;
begin
  {$IFDEF DEBUG}
  EZAssert(not IsBeforeFirst, ascAlreadyAtStart);
  {$ENDIF}
  Temp := llCursor^.Link;
  llCursor^.Link := llBF^.Link;
  llBF^.Link := llCursor;
  llCursor := Temp;
end;
{--------}
function TLinkList.Replace(aData : pointer) : pointer;
begin
  {$IFDEF DEBUG}
  EZAssert((not IsBeforeFirst) and (not IsAfterLast), ascReplaceEdges);
  {$ENDIF}
  if IsSorted then begin
    Result := Examine;
    Delete;
    InsertSorted(aData);
  end
  else with llCursor^ do begin
    Result := Data;
    Data := aData;
  end;
end;
{--------}
function TLinkList.Search(aData : pointer) : boolean;
var
  CompResult   : integer;
  StillLooking : boolean;
  Found        : boolean;
  i            : longint;
  L, R, M      : longint;
  CursorNumber : longint;
  StartNumber  : longint;
  TempCursor   : PNode;
  StartCursor  : PNode;
begin
  if IsSorted then begin
    if (Count = 0) then begin
      Result := false;
      SetAfterLast;
      Exit;
    end;
    if not IsBeforeFirst then
      SetBeforeFirst;
    L := 0;
    R := pred(Count);
    CursorNumber := -1;
    StartNumber := -1;
    StartCursor := llBF;
    TempCursor := llBF;
    while (L <= R) do begin
      M := (L + R) shr 1;
      if (CursorNumber <= M) then begin
        StartCursor := TempCursor;
        StartNumber := CursorNumber;
      end
      else {CursorNumber > M} begin
        TempCursor := StartCursor;
      end;
      for i := 1 to (M - StartNumber) do
        TempCursor := TempCursor^.Link;
      CursorNumber := M;
      CompResult := Compare(aData, TempCursor^.Data);
      if (CompResult < 0) then
        R := pred(M)
      else if (CompResult > 0) then
        L := succ(M)
      else begin
        Result := true;
        llNextN(CursorNumber+1);                               {!!.02}
        Exit;
      end;
    end;
    Result := false;
    if (L > CursorNumber) then
      inc(CursorNumber)
    else if (L < CursorNumber) then
      dec(CursorNumber);
    llNextN(CursorNumber+1);
  end
  else {the list is not currently sorted, search from the start} begin
    SetBeforeFirst;
    StillLooking := true;
    Found := false;
    while StillLooking and (not Found) do begin
      Next;
      if IsAfterLast then
        StillLooking := false
      else
        Found := (Compare(aData, Examine) = 0);
    end;
    Result := Found;
  end;
end;
{--------}
procedure TLinkList.SetAfterLast;
var
  TempCursor,
  NextLink,
  Temp : PNode;
begin
  {for speed reasons, code from first principles,
   this is equivalent to:
     while not IsAfterLast do Next;}
  NextLink := llBF^.Link;
  TempCursor := llCursor;
  while (TempCursor <> llAL) do begin
    Temp := TempCursor;
    TempCursor := NextLink;
    NextLink := TempCursor^.Link;
    TempCursor^.Link := Temp;
  end;
  llCursor := TempCursor;
  llBF^.Link := NextLink;
end;
{--------}
procedure TLinkList.SetBeforeFirst;
var
  TempCursor,
  NextLink,
  Temp : PNode;
begin
  {for speed reasons, code from first principles,
   this is equivalent to:
     while not IsBeforeFirst do Prev;}
  NextLink := llBF^.Link;
  TempCursor := llCursor;
  while (TempCursor <> llBF) do begin
    Temp := TempCursor^.Link;
    TempCursor^.Link := NextLink;
    NextLink := TempCursor;
    TempCursor := Temp;
  end;
  llCursor := TempCursor;
  llBF^.Link := NextLink;
end;
{--------}
function TLinkList.Split : TLinkList;
var
  TempCount : longint;
  NewList   : TLinkList;
  LastNodeLeftBehind,
  JoinNode  : PNode;
begin
  {$IFDEF DEBUG}
  EZAssert((not IsBeforeFirst) and (not IsAfterLast), ascSplitEdges);
  {$ENDIF}

  NewList := TLinkList(TAbstractContainerClass(ClassType).Create(IsDataOwner));
  NewList.Compare := Compare;
  NewList.DupData := DupData;
  NewList.DisposeData := DisposeData;
  NewList.IsSorted := IsSorted;
  Result := NewList;

  LastNodeLeftBehind := llCursor^.Link;

  TempCount := 0;
  JoinNode := llCursor;
  while not IsAfterLast do begin
    inc(TempCount);
    Next;
  end;

  JoinNode^.Link := NewList.llBF;
  NewList.llCursor := llAL^.Link;
  NewList.Next;
  NewList.acCount := TempCount;

  dec(acCount, TempCount);
  llAL^.Link := LastNodeLeftBehind;
end;
{====================================================================}


{$IFDEF ThreadsExist}
{===TThreadsafeLinkList==============================================}
constructor TThreadsafeLinkList.Create(aDataOwner : boolean);
begin
  inherited Create;
  llResLock := TezResourceLock.Create;
  llLinkList := TLinkList.Create(aDataOwner);
end;
{--------}
destructor TThreadsafeLinkList.Destroy;
begin
  llLinkList.Free;
  llResLock.Free;
  inherited Destroy;
end;
{--------}
function TThreadsafeLinkList.AcquireAccess : TLinkList;
begin
  llResLock.Lock;
  Result := llLinkList;
end;
{--------}
procedure TThreadsafeLinkList.ReleaseAccess;
begin
  llResLock.Unlock;
end;
{====================================================================}
{$ENDIF}

end.