* rebase to trunk@17295avr

git-svn-id: http://svn.freepascal.org/svn/fpc/branches/avr@17296 3ad0048d-3df7-0310-abae-a5850022a9f2

9 files changed, 1545 insertions, 0 deletions

diff --git a/packages/fcl-stl/src/garrayutils.pp b/packages/fcl-stl/src/garrayutils.pp
new file mode 100644
index 0000000000..f9773b63db
--- /dev/null
+++ b/packages/fcl-stl/src/garrayutils.pp
@@ -0,0 +1,254 @@
+{
+   This file is part of the Free Pascal FCL library.
+   BSD parts (c) 2011 Vlado Boza
+
+   See the file COPYING.FPC, included in this distribution,
+   for details about the copyright.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY;without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+**********************************************************************}
+{$mode objfpc}
+
+unit garrayutils;
+
+interface
+
+const MaxDepth=60;
+const InsertSortThreshold=16;
+
+{TCompare is comparing class, which should have class method c(a,b:TValue):boolean, which returns true if a is less than b}
+type
+  generic TOrderingArrayUtils<TArr, Tvalue, TCompare>=class
+  private
+    class procedure Sortrange(var Arr:TArr; Start,Fin,d:SizeUInt);
+    class procedure HeapSort(var Arr:TArr; Start,Fin:SizeUInt);
+    class procedure InsertSort(var Arr:TArr; Start,Fin:SizeUInt);
+    class function Left(a:SizeUInt):SizeUInt;inline;
+    class function Right(a:SizeUInt):SizeUInt;inline;
+    class procedure Heapify(var Arr: TArr; Position:SizeUInt; Start,Fin:SizeUInt);
+    class function Parent(a:SizeUInt):SizeUInt;inline;
+  public
+    class procedure Sort(var Arr: TArr; size:SizeUInt);
+    class function NextPermutation(var Arr: TArr; size:SizeUInt):boolean;
+  end;
+
+  generic TArrayUtils<TArr, Tvalue>=class
+  public
+    class procedure RandomShuffle(Arr: TArr; size: SizeUInt);
+  end;
+
+implementation
+
+class function TOrderingArrayUtils.Left(a:SizeUInt):SizeUInt;inline;
+begin
+  Left:=((a+1)shl 1)-1;
+end;
+
+class function TOrderingArrayUtils.Right(a:SizeUInt):SizeUInt;inline;
+begin
+  Right:=(a+1) shl 1;
+end;
+
+class function TOrderingArrayUtils.Parent(a:SizeUInt):SizeUInt;inline;
+begin
+  Parent:=(a-1)shr 1;
+end;
+
+class procedure TOrderingArrayUtils.Heapify(var Arr: TArr; Position:SizeUInt; Start,Fin:SizeUInt);
+var mpos,l,r:SizeUInt; temp:TValue;
+begin
+  while(true) do 
+  begin
+    mpos:=Position;
+    l:=Left(Position-Start)+Start;
+    r:=Right(Position-Start)+Start;
+    if (l<Fin) AND (TCompare.c(Arr[mpos],Arr[l])) then
+      mpos:=l;
+    if (r<Fin) AND (TCompare.c(Arr[mpos],Arr[r])) then
+      mpos:=r;
+    if mpos = Position then break;
+    
+    temp:=Arr[Position];
+    Arr[Position]:=Arr[mpos];
+    Arr[mpos]:=temp;
+    Position:=mpos;
+  end;
+end;
+
+class procedure TOrderingArrayUtils.Sort(var Arr:TArr; size:SizeUInt);inline;
+begin
+  Sortrange(Arr,0,size,0);
+  InsertSort(Arr,0,size);
+end;
+
+class procedure TOrderingArrayUtils.Sortrange(var Arr:TArr; Start,Fin,d:SizeUInt);
+var pivot,temp:Tvalue; i,j,k,l:SizeUInt;
+begin
+  if (Fin-Start) <= InsertSortThreshold then
+  begin
+    InsertSort(Arr,Start,Fin);
+    exit;
+  end;
+  if d>=maxdepth then
+  begin
+    HeapSort(Arr, Start, Fin);
+    exit;
+  end;
+{median of 3} 
+  j:=Start;
+  k:=Fin-1;
+  l:=(Start+Fin)div 2;
+  if(TCompare.c(Arr[j],Arr[k])) and (TCompare.c(Arr[j],Arr[l])) then
+  begin
+    if(TCompare.c(Arr[k],Arr[l])) then
+    begin
+      temp:=Arr[k];
+      Arr[k]:=Arr[j];
+      Arr[j]:=temp;
+    end else 
+    begin
+      temp:=Arr[l];
+      Arr[l]:=Arr[j];
+      Arr[j]:=temp;
+    end;
+  end
+  else if(TCompare.c(Arr[k],Arr[j])) and (TCompare.c(Arr[l],Arr[j])) then
+  begin
+    if(TCompare.c(Arr[l],Arr[k])) then
+    begin
+      temp:=Arr[k];
+      Arr[k]:=Arr[j];
+      Arr[j]:=temp;
+    end else
+    begin
+      temp:=Arr[l];
+      Arr[l]:=Arr[j];
+      Arr[j]:=temp;
+    end;
+  end;
+
+{partition} 
+  pivot:=Arr[Start];
+
+  i:=Start-1;
+  j:=Fin;
+  repeat 
+    repeat
+      dec(j);
+    until (not (TCompare.c(pivot,Arr[j])));
+   
+    
+    repeat
+      inc(i);
+    until (not (TCompare.c(Arr[i],pivot)));
+    if(i < j) then
+    begin
+      temp:=Arr[i];
+      Arr[i]:=Arr[j];
+      Arr[j]:=temp;
+    end;
+  until (i>=j);
+
+  Sortrange(Arr, Start, j+1, d+1);
+  Sortrange(Arr, j+1, Fin, d+1);
+end;
+
+class procedure TOrderingArrayUtils.InsertSort(var Arr:TArr; Start,Fin:SizeUInt);inline;
+var i,j:SizeUInt; temp:Tvalue;
+begin
+  for i:=Start+1 to Fin-1 do
+  begin
+    j:=i;
+    temp:=Arr[i];
+    while (j>0) and (TCompare.c(temp,Arr[j-1])) do
+    begin
+      Arr[j]:=Arr[j-1];
+      dec(j);
+    end;
+    Arr[j]:=temp;
+  end;
+end;
+
+class procedure TOrderingArrayUtils.HeapSort(var Arr: TArr; Start,Fin:SizeUInt);
+var i,cur,next,l,r,size:SizeUInt; temp:Tvalue;
+begin
+{buildHeap}
+  size:=Fin-Start;
+  for i:=((size div 2)-1) downto 0 do 
+    Heapify(Arr, i+Start, Start, Fin);
+{bottomup HeapSort}
+  for i:=size-1 downto 1 do
+  begin
+    Fin:=Fin-1;
+    cur:=Start;
+    temp:=Arr[Start];
+    while(true) do
+    begin
+      l:=Left(cur-Start)+Start;
+      if l>=Fin then 
+        break;
+      next:=l;
+      r:=Right(cur-Start)+Start;
+      if (r<Fin) AND (TCompare.c(Arr[l],Arr[r])) then
+        next:=r;
+      Arr[cur]:=Arr[next];
+      cur:=next;
+    end;
+    Arr[cur]:=temp;
+    temp:=Arr[i+Start];
+    Arr[i+Start]:=Arr[cur];
+    Arr[cur]:=temp;
+    l:=Parent(cur-Start)+Start;
+    while (cur <> 0) AND (TCompare.c(Arr[l],Arr[cur])) do
+    begin
+      temp:=Arr[cur];
+      Arr[cur]:=Arr[l];
+      Arr[l]:=temp;
+      cur:=l;
+      l:=Parent(cur-Start)+Start;
+    end;
+  end;
+end;
+
+class function TOrderingArrayUtils.NextPermutation(var Arr: TArr; size: SizeUInt):boolean;
+var i,f:SizeUInt; temp:TValue;
+begin
+  f := -1;
+  for i:=size-1 downto 1 do begin 
+    if (TCompare.c(arr[i-1], arr[i])) then begin
+      f := i-1;
+      break;
+    end;
+  end;
+  if f = -1 then exit(false);
+  for i:=size-1 downto 1 do begin
+    if (TCompare.c(arr[f], arr[i])) then begin
+      temp:=arr[f]; arr[f] := arr[i]; arr[i] := temp;
+      break;
+    end;
+  end;
+  i:= size-1;
+  inc(f);
+  while (i > f) do begin
+    temp:=arr[f]; arr[f] := arr[i]; arr[i] := temp;
+    dec(i); inc(f);
+  end;
+  NextPermutation := true;
+end;
+
+class procedure TArrayUtils.RandomShuffle(Arr: TArr; size: SizeUInt);
+var i,r:SizeUInt; temp:Tvalue;
+begin
+  for i:=size-1 downto 1 do begin
+    r:=random(Int64(i));
+    temp:=Arr[r];
+    Arr[r]:=Arr[i];
+    Arr[i]:=temp;
+  end;
+end;
+
+
+end.
diff --git a/packages/fcl-stl/src/gdeque.pp b/packages/fcl-stl/src/gdeque.pp
new file mode 100644
index 0000000000..f83956f3c5
--- /dev/null
+++ b/packages/fcl-stl/src/gdeque.pp
@@ -0,0 +1,204 @@
+{
+   This file is part of the Free Pascal FCL library.
+   BSD parts (c) 2011 Vlado Boza
+
+   See the file COPYING.FPC, included in this distribution,
+   for details about the copyright.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY;without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+**********************************************************************}
+{$mode objfpc}
+
+unit gdeque;
+
+interface
+
+type
+  generic TDeque<T>=class
+  private
+  type 
+    PT=^T;
+    TArr=array of T;
+  var 
+    FData:TArr;
+    FDataSize:SizeUInt;
+    FCapacity:SizeUInt;
+    FStart:SizeUInt;
+    procedure SetValue(position:SizeUInt; value:T);inline;
+    function GetValue(position:SizeUInt):T;inline;
+    function GetMutable(position:SizeUInt):PT;inline;
+    procedure IncreaseCapacity();inline;
+  public
+    function Size():SizeUInt;inline;
+    constructor Create();
+    procedure PushBack(value:T);inline;
+    procedure PushFront(value:T);inline;
+    procedure PopBack();inline;
+    procedure PopFront();inline;
+    function Front():T;inline;
+    function Back():T;inline;
+    function IsEmpty():boolean;inline;
+    procedure Reserve(cap:SizeUInt);inline;
+    procedure Resize(cap:SizeUInt);inline;
+    procedure Insert(Position:SizeUInt; Value:T);inline;
+    procedure Erase(Position:SIzeUInt);inline;
+    property Items[i : SizeUInt]: T read GetValue write SetValue; default;
+    property Mutable[i : SizeUInt]:PT read GetMutable;
+end;
+
+implementation
+
+constructor TDeque.Create();
+begin
+  FDataSize:=0;
+  FCapacity:=0;
+  FStart:=0;
+end;
+
+function TDeque.Size():SizeUInt;inline;
+begin
+  Size:=FDataSize;
+end;
+
+function TDeque.IsEmpty():boolean;inline;
+begin
+  if Size()=0 then 
+    IsEmpty:=true
+  else 
+    IsEmpty:=false;
+end;
+
+procedure TDeque.PushBack(value:T);inline;
+begin
+  if(FDataSize=FCapacity) then 
+    IncreaseCapacity;
+  FData[(FStart+FDataSize)mod FCapacity]:=value;
+  inc(FDataSize);
+end;
+
+procedure TDeque.PopFront();inline;
+begin
+  if(FDataSize>0) then 
+  begin
+    inc(FStart);
+    dec(FDataSize);
+    if(FStart=FCapacity) then 
+      FStart:=0;
+  end;
+end;
+
+procedure TDeque.PopBack();inline;
+begin
+  if(FDataSize>0) then
+    dec(FDataSize);
+end;
+
+procedure TDeque.PushFront(value:T);inline;
+begin
+  if(FDataSize=FCapacity) then
+    IncreaseCapacity;
+  if(FStart=0) then
+    FStart:=FCapacity-1
+  else
+    dec(FStart);
+  FData[FStart]:=value;
+  inc(FDataSize);
+end;
+
+function TDeque.Front():T;inline;
+begin
+  Assert(size > 0, 'Accessing empty deque');
+  Front:=FData[FStart];
+end;
+
+function TDeque.Back():T;inline;
+begin
+  Assert(size > 0, 'Accessing empty deque');
+  Back:=FData[(FStart+FDataSize-1)mod FCapacity];
+end;
+
+procedure TDeque.SetValue(position:SizeUInt; value:T);inline;
+begin
+  Assert(position < size, 'Deque access out of range');
+  FData[(FStart+position)mod FCapacity]:=value;
+end;
+
+function TDeque.GetValue(position:SizeUInt):T;inline;
+begin
+  Assert(position < size, 'Deque access out of range');
+  GetValue:=FData[(FStart+position) mod FCapacity];
+end;
+
+function TDeque.GetMutable(position:SizeUInt):PT;inline;
+begin
+  Assert(position < size, 'Deque access out of range');
+  GetMutable:=@FData[(FStart+position) mod FCapacity];
+end;
+
+procedure TDeque.IncreaseCapacity;inline;
+var i,OldEnd:SizeUInt;
+begin
+  OldEnd:=FCapacity;
+  if(FCapacity=0) then
+    FCapacity:=1
+  else
+    FCapacity:=FCapacity*2;
+  SetLength(FData, FCapacity);
+  if (FStart>0) then 
+    for i:=0 to FStart-1 do
+      FData[OldEnd+i]:=FData[i];
+end;
+
+procedure TDeque.Reserve(cap:SizeUInt);inline;
+var i,OldEnd:SizeUInt;
+begin
+  if(cap<FCapacity) then 
+    exit
+  else if(cap<=2*FCapacity) then 
+    IncreaseCapacity
+  else 
+  begin
+    OldEnd:=FCapacity;
+    FCapacity:=cap;
+    SetLength(FData, FCapacity);
+    if FStart > 0 then
+      for i:=0 to FStart-1 do
+        FData[OldEnd+i]:=FData[i];
+  end;
+end;
+
+procedure TDeque.Resize(cap:SizeUInt);inline;
+begin
+  Reserve(cap);
+  FDataSize:=cap;
+end;
+
+procedure TDeque.Insert(Position:SizeUInt; Value: T);inline;
+var i:SizeUInt;
+begin
+  pushBack(Value);
+  for i:=Size-1 downto Position+1 do 
+  begin
+    Items[i]:=Items[i-1];
+  end;
+  Items[Position]:=Value;
+end;
+
+procedure TDeque.Erase(Position:SizeUInt);inline;
+var i:SizeUInt;
+begin
+  if Position <= Size then 
+  begin
+    for i:=Position to Size-2 do
+    begin
+      Items[i]:=Items[i+1];
+    end;
+    popBack();
+  end;
+end;
+
+
+end.
diff --git a/packages/fcl-stl/src/gmap.pp b/packages/fcl-stl/src/gmap.pp
new file mode 100644
index 0000000000..fb64db26b5
--- /dev/null
+++ b/packages/fcl-stl/src/gmap.pp
@@ -0,0 +1,163 @@
+{
+   This file is part of the Free Pascal FCL library.
+   BSD parts (c) 2011 Vlado Boza
+
+   See the file COPYING.FPC, included in this distribution,
+   for details about the copyright.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY;without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+**********************************************************************}
+{$mode objfpc}
+
+unit gmap;
+
+interface
+
+uses gset;
+
+type
+  generic TMapCompare<TPair, TKeyCompare>=class
+    class function c(a,b :TPair):boolean;
+  end;
+
+  generic TMap<TKey, TValue, TCompare>=class
+  public
+  type
+    TPair=record
+      Value:TValue;
+      Key:TKey;
+    end;
+    TMCompare = specialize TMapCompare<TPair, TCompare>;
+    TMSet = specialize TSet<TPair, TMCompare>;
+    PTValue = ^TValue;
+    PTPair = ^TPair;
+  var
+  private
+    FSet:TMSet;
+  public
+    function Find(key:TKey):TMSet.PNode;inline;
+    function FindLess(key:TKey):TMSet.PNode;inline;
+    function FindLessEqual(key:TKey):TMSet.PNode;inline;
+    function FindGreater(key:TKey):TMSet.PNode;inline;
+    function FindGreaterEqual(key:TKey):TMSet.PNode;inline;
+    function GetValue(key:TKey):TValue;inline;
+    procedure Insert(key:TKey; value:TValue);inline;
+    function Min:TMSet.PNode;inline;
+    function Max:TMSet.PNode;inline;
+    function Next(x:TMSet.PNode):TMSet.PNode;inline;
+    function Prev(x:TMSet.PNode):TMSet.PNode;inline;
+    procedure Delete(key:TKey);inline;
+    function Size:SizeUInt;inline;
+    function IsEmpty:boolean;inline;
+    constructor Create;
+    destructor Destroy;override;
+    property Items[i : TKey]: TValue read GetValue write Insert; default;
+  end;
+
+implementation
+
+class function TMapCompare.c(a,b: TPair):boolean;
+begin
+  c:= TKeyCompare.c(a.Key, b.Key);
+end;
+
+constructor TMap.Create;
+begin
+  FSet:=TMSet.Create;
+end;
+
+destructor TMap.Destroy;
+begin
+  FSet.Destroy;
+end;
+
+procedure TMap.Delete(key:TKey);inline;
+var Pair:TPair;
+begin
+  Pair.Key:=key;
+  FSet.Delete(Pair);
+end;
+
+function TMap.Find(key:TKey):TMSet.PNode;inline;
+var Pair:TPair;
+begin
+  Pair.Key:=key;
+  Find:=FSet.Find(Pair);
+end;
+
+function TMap.FindLess(key:TKey):TMSet.PNode;inline;
+var Pair:TPair;
+begin
+  Pair.Key:=key;
+  FindLess:=FSet.FindLess(Pair);
+end;
+
+function TMap.FindLessEqual(key:TKey):TMSet.PNode;inline;
+var Pair:TPair;
+begin
+  Pair.Key:=key;
+  FindLessEqual:=FSet.FindLessEqual(Pair);
+end;
+
+function TMap.FindGreater(key:TKey):TMSet.PNode;inline;
+var Pair:TPair;
+begin
+  Pair.Key:=key;
+  FindGreater:=FSet.FindGreater(Pair);
+end;
+
+function TMap.FindGreaterEqual(key:TKey):TMSet.PNode;inline;
+var Pair:TPair;
+begin
+  Pair.Key:=key;
+  FindGreaterEqual:=FSet.FindGreaterEqual(Pair);
+end;
+
+function TMap.GetValue(key:TKey):TValue;inline;
+var Pair:TPair;
+begin
+  Pair.Key:=key;
+  GetValue:=FSet.Find(Pair)^.Data.Value;
+end;
+
+procedure TMap.Insert(key:TKey; value:TValue);inline;
+var Pair:TPair;
+begin
+  Pair.Key:=key;
+  FSet.Insert(Pair)^.Data.Value := value;
+end;
+
+function TMap.Min:TMSet.PNode;inline;
+begin
+  Min:=FSet.Min;
+end;
+
+function TMap.Max:TMSet.PNode;inline;
+begin
+  Max:=FSet.Max;
+end;
+
+function TMap.Next(x:TMSet.PNode):TMSet.PNode;inline;
+begin
+  Next:=FSet.Next(x);
+end;
+
+function TMap.Prev(x:TMSet.PNode):TMSet.PNode;inline;
+begin
+  Prev:=FSet.Prev(x);
+end;
+
+function TMap.Size:SizeUInt;inline;
+begin
+  Size:=FSet.Size;
+end;
+
+function TMap.IsEmpty:boolean;inline;
+begin
+  IsEmpty:=FSet.IsEmpty;
+end;
+
+end.
diff --git a/packages/fcl-stl/src/gpriorityqueue.pp b/packages/fcl-stl/src/gpriorityqueue.pp
new file mode 100644
index 0000000000..7aa3d32cbc
--- /dev/null
+++ b/packages/fcl-stl/src/gpriorityqueue.pp
@@ -0,0 +1,141 @@
+{
+   This file is part of the Free Pascal FCL library.
+   BSD parts (c) 2011 Vlado Boza
+
+   See the file COPYING.FPC, included in this distribution,
+   for details about the copyright.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY;without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+**********************************************************************}
+{$mode objfpc}
+
+unit gpriorityqueue;
+
+interface 
+
+uses gvector;
+
+{TCompare is comparing class, which should have class method c(a,b:T):boolean, which returns true is a is less than b}
+
+type 
+  generic TPriorityQueue<T, TCompare>=class
+  private
+  type 
+    TContainer=specialize TVector<T>;
+  var
+    FData:TContainer;
+    
+    procedure PushUp(position:SizeUInt);
+    function Left(a:SizeUInt):SizeUInt;inline;
+    function Right(a:SizeUInt):SizeUInt;inline;
+    procedure Heapify(position:SizeUInt);
+    function Parent(a:SizeUInt):SizeUInt;inline;
+  public
+    constructor Create;
+    destructor Destroy;override;
+    function Top:T;inline;
+    procedure Pop;inline;
+    procedure Push(value:T);inline;
+    function Size:SizeUInt;inline;
+    function IsEmpty:boolean;inline;
+  end;
+
+implementation
+
+constructor TPriorityQueue.Create;
+begin
+  FData:=TContainer.Create;
+end;
+
+destructor TPriorityQueue.Destroy;
+begin;
+  FData.Destroy;
+end;
+
+function TPriorityQueue.Size:SizeUInt;inline;
+begin
+  Size:=FData.Size;
+end;
+
+function TPriorityQueue.IsEmpty:boolean;inline;
+begin
+  IsEmpty:=FData.Size=0;
+end;
+
+function TPriorityQueue.Top:T;inline;
+begin
+  Top:=FData[0];
+end;
+
+procedure TPriorityQueue.Pop;inline;
+begin
+  if not IsEmpty then begin
+    FData[0]:=FData.back;
+    FData.PopBack;
+    Heapify(0);
+  end;
+end;
+
+procedure TPriorityQueue.PushUp(position:SizeUInt);
+var np:SizeUInt; temp:T;
+begin
+  while(position>0) do
+  begin
+    np := Parent(position);
+    if(TCompare.c(FData[np],FData[position])) then
+    begin
+      temp:=FData[np];
+      FData[np]:=FData[position];
+      FData[position]:=temp;
+      position:=np;
+    end else
+      break;
+  end;
+end;
+
+procedure TPriorityQueue.Push(value:T);inline;
+begin
+  FData.PushBack(value);
+  PushUp(FData.Size-1);
+end;
+
+function TPriorityQueue.Left(a:SizeUInt):SizeUInt;inline;
+begin
+  Left:=((a+1)shl 1)-1;
+end;
+
+function TPriorityQueue.Right(a:SizeUInt):SizeUInt;inline;
+begin
+  Right:=(a+1) shl 1;
+end;
+
+function TPriorityQueue.Parent(a:SizeUInt):SizeUInt;inline;
+begin
+  Parent:=(a-1)shr 1;
+end;
+
+procedure TPriorityQueue.Heapify(position:SizeUInt);
+var mpos,l,r:SizeUInt; temp:T;
+begin
+  while(true) do
+  begin
+    mpos:=position;
+    l:=Left(position);
+    r:=Right(position);
+    if (l<FData.Size) AND (TCompare.c(FData[mpos],FData[l])) then
+      mpos:=l;
+    if (r<FData.Size) AND (TCompare.c(FData[mpos],FData[r])) then
+      mpos:=r;
+    if mpos = position then break;
+
+    temp:=FData[position];
+    FData[position]:=FData[mpos];
+    FData[mpos]:=temp;
+    position:=mpos;
+  end;
+end;
+
+end.
diff --git a/packages/fcl-stl/src/gqueue.pp b/packages/fcl-stl/src/gqueue.pp
new file mode 100644
index 0000000000..a56aef4e47
--- /dev/null
+++ b/packages/fcl-stl/src/gqueue.pp
@@ -0,0 +1,75 @@
+{
+   This file is part of the Free Pascal FCL library.
+   BSD parts (c) 2011 Vlado Boza
+
+   See the file COPYING.FPC, included in this distribution,
+   for details about the copyright.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY;without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+**********************************************************************}
+{$mode objfpc}
+
+unit gqueue;
+
+interface
+
+uses gdeque;
+
+type 
+  generic TQueue<T>=class
+  private
+  type 
+    TContainer = specialize TDeque<T>;
+  var
+    FData:TContainer;
+  public
+    procedure Push(value:T);inline;
+    procedure Pop();inline;
+    function Front():T;inline;
+    function Size():SizeUInt;inline;
+    function IsEmpty():boolean;inline;
+    constructor Create;
+    destructor Destroy;override;
+end;
+
+implementation
+
+constructor TQueue.Create;
+begin
+  FData:=TContainer.Create;
+end;
+
+destructor TQueue.Destroy;
+begin
+  FData.Destroy;
+end;
+
+procedure TQueue.Push(value:T);inline;
+begin
+  FData.PushBack(value);
+end;
+
+procedure TQueue.Pop();inline;
+begin
+  FData.PopFront;
+end;
+
+function TQueue.Front:T;inline;
+begin
+  Front:=FData.Front;
+end;
+
+function TQueue.Size:SizeUInt;inline;
+begin
+  Size:=FData.Size;
+end;
+
+function TQueue.IsEmpty:boolean;inline;
+begin
+  IsEmpty:=FData.IsEmpty;
+end;
+
+end.
diff --git a/packages/fcl-stl/src/gset.pp b/packages/fcl-stl/src/gset.pp
new file mode 100644
index 0000000000..01f2937644
--- /dev/null
+++ b/packages/fcl-stl/src/gset.pp
@@ -0,0 +1,423 @@
+{
+   This file is part of the Free Pascal FCL library.
+   BSD parts (c) 2011 Vlado Boza
+
+   See the file COPYING.FPC, included in this distribution,
+   for details about the copyright.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY;without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+**********************************************************************}
+{$mode objfpc}
+
+unit gset;
+
+interface
+
+const RED=true;
+const BLACK=false;
+
+type
+  generic TSet<T, TCompare>=class
+  public
+  type 
+    PNode=^Node;
+    Node=record
+      Data:T;
+      Left,Right:PNode;
+      Parent:PNode;
+      Color:boolean;
+    end;
+  var
+  private
+    FBase:PNode;
+    FSize:SizeUInt;
+    
+    function CreateNode(Data:T):PNode;inline;
+    procedure DestroyNodeAndChilds(nod:PNode);
+    procedure DestroyNode(nod:PNode);
+    function RotateRight(nod:PNode):PNode;inline;
+    function RotateLeft(nod:PNode):PNode;inline;
+    procedure FlipColors(nod:PNode);inline;
+    function IsRed(nod:PNode):boolean;inline;
+    function Insert(value:T; nod:PNode; var position:PNode):PNode;
+    function FixUp(nod:PNode):PNode;inline;
+    function MoveRedLeft(nod:PNode):PNode;inline;
+    function MoveRedRight(nod:PNode):PNode;inline;
+    function DeleteMin(nod:PNode):PNode;
+    function Delete(value:T; nod:PNode):PNode;
+    function Min(nod:PNode):PNode;inline;
+    
+  public
+    function Find(value:T):PNode;inline;
+    function FindLess(value:T):PNode;inline;
+    function FindLessEqual(value:T):PNode;inline;
+    function FindGreater(value:T):PNode;inline;
+    function FindGreaterEqual(value:T):PNode;inline;
+    function Insert(value:T):PNode;inline;
+    function Min:PNode;inline;
+    function Max:PNode;inline;
+    function Next(x:PNode):PNode;inline;
+    function Prev(x:PNode):PNode;inline;
+    procedure Delete(value:T);inline;
+    public constructor Create;
+    public destructor Destroy;override;
+    function Size:SizeUInt;
+    function IsEmpty:boolean;
+  end;
+
+implementation
+
+constructor TSet.Create;
+begin
+  FBase:=nil;
+  FSize:=0;
+end;
+
+destructor TSet.Destroy;
+begin
+  DestroyNodeAndChilds(FBase);
+end;
+
+function TSet.Size:SizeUInt;
+begin
+  Size:=FSize;
+end;
+
+function TSet.IsEmpty:boolean;
+begin
+  IsEmpty := FSize=0;
+end;
+
+procedure TSet.DestroyNodeAndChilds(nod:PNode);
+begin
+  if nod = nil then exit;
+  DestroyNodeAndChilds(nod^.left);
+  DestroyNodeAndChilds(nod^.right);
+  DestroyNode(nod);
+end;
+
+procedure TSet.DestroyNode(nod:PNode);
+begin
+  Finalize(nod^.Data);
+  dispose(nod);
+  dec(FSize);
+end;
+
+function TSet.CreateNode(Data:T):PNode;inline;
+var temp:PNode;
+begin
+  temp:=new(PNode);
+  Initialize(temp^.Data);
+  temp^.Data:=Data;
+  temp^.Left:=nil;
+  temp^.Right:=nil;
+  temp^.Parent:=nil;
+  temp^.Color:=RED;
+  inc(FSize);
+  CreateNode:=temp;
+end;
+
+function TSet.RotateRight(nod:PNode):PNode;inline;
+var temp:PNode;
+begin
+  temp:=nod^.Left;
+
+  temp^.Parent:=nod^.Parent;
+  nod^.Parent:=temp;
+
+  nod^.Left:=temp^.Right;
+  temp^.Right:=nod;
+
+  if(nod^.Left<>nil) then nod^.Left^.Parent:=nod;
+
+  temp^.Color:=nod^.Color;
+  nod^.Color:=RED;
+  exit(temp);
+end;
+
+function TSet.RotateLeft(nod:PNode):PNode;inline;
+var temp:PNode;
+begin
+  temp:=nod^.Right;
+
+  temp^.Parent:=nod^.Parent;
+  nod^.Parent:=temp;
+
+  nod^.Right:=temp^.Left;
+  temp^.Left:=nod;
+
+  if(nod^.Right<>nil) then nod^.Right^.Parent:=nod;
+
+  temp^.Color:=nod^.Color;
+  nod^.Color:=RED;
+  exit(temp);
+end;
+
+procedure TSet.FlipColors(nod:PNode);inline;
+begin
+  nod^.Color:= not nod^.Color;
+  nod^.Left^.Color := not nod^.Left^.Color;
+  nod^.Right^.Color := not nod^.Right^.Color;
+end;
+
+
+function TSet.FixUp(nod:PNode):PNode;inline;
+begin
+  if(IsRed(nod^.Right)) and (not IsRed(nod^.Left)) then nod := rotateLeft(nod);
+  if(IsRed(nod^.Left)) and (IsRed(nod^.Left^.Left)) then nod := rotateRight(nod);
+  if(IsRed(nod^.Right)) and (IsRed(nod^.Left)) then flipColors(nod);
+  FixUp:=nod;
+end;
+
+function TSet.MoveRedLeft(nod:PNode):PNode;inline;
+begin
+  flipColors(nod);
+    if (IsRed(nod^.Right^.Left)) then begin 
+          nod^.Right := rotateRight(nod^.Right);
+          nod := rotateLeft(nod);
+          flipColors(nod);
+    end;
+  MoveRedLeft:=nod;
+end;
+
+function TSet.MoveRedRight(nod:PNode):PNode;inline;
+begin
+  flipColors(nod);
+    if (IsRed(nod^.Left^.Left)) then begin 
+          nod := rotateRight(nod);
+          flipColors(nod);
+    end;
+  MoveRedRight:=nod;
+end;
+
+function TSet.DeleteMin(nod:PNode):PNode;
+begin
+  if (nod^.Left = nil) then begin
+    DestroyNode(nod);
+    exit(nil);
+  end;
+
+  if ((not IsRed(nod^.Left)) and (not IsRed(nod^.Left^.Left))) then nod := MoveRedLeft(nod);
+
+  nod^.Left := DeleteMin(nod^.Left);
+
+  exit(FixUp(nod));
+end;
+
+function TSet.Delete(value:T; nod:PNode):PNode;
+begin
+  if (TCompare.c(value, nod^.Data)) then begin
+    if (nod^.Left=nil) then exit(nod);
+    if ((not IsRed(nod^.Left)) and ( not IsRed(nod^.Left^.Left))) then 
+      nod := MoveRedLeft(nod);
+    nod^.Left := Delete(value, nod^.Left);
+  end
+  else begin
+    if (IsRed(nod^.Left)) then begin 
+      nod := rotateRight(nod);
+    end;
+    if ((not TCompare.c(value,nod^.Data)) and (not TCompare.c(nod^.Data,value)) and (nod^.Right = nil)) then 
+    begin
+      DestroyNode(nod);
+      exit(nil);
+    end;
+    if (nod^.Right=nil) then exit(nod);
+    if ((not IsRed(nod^.Right)) and (not IsRed(nod^.Right^.Left))) then nod := MoveRedRight(nod);
+    if ((not TCompare.c(value,nod^.Data)) and (not TCompare.c(nod^.Data,value))) then begin
+      nod^.Data := Min(nod^.Right)^.Data;
+      nod^.Right := DeleteMin(nod^.Right);
+    end
+    else nod^.Right := Delete(value, nod^.Right);
+  end;
+  exit(FixUp(nod));
+end;
+
+procedure TSet.Delete(value:T);inline;
+begin
+  if(FBase<>nil) then FBase:=Delete(value, FBase);
+  if(FBase<>nil) then FBase^.Color:=BLACK;
+end;
+
+
+function TSet.Find(value:T):PNode;inline;
+var x:PNode;
+begin
+  x:=FBase;
+  while(x <> nil) do begin
+    if(TCompare.c(value,x^.Data)) then x:=x^.Left
+    else if(TCompare.c(x^.Data,value)) then x:=x^.Right
+    else exit(x);
+  end;
+  exit(nil);
+end;
+
+function TSet.FindLess(value:T):PNode;inline;
+var x,cur:PNode;
+begin
+  x:=nil;
+  cur:=FBase;
+  while (cur <> nil) do begin
+    if (TCompare.c(cur^.Data, value)) then
+    begin
+      x:=cur;
+      cur:=cur^.right;
+    end else
+      cur:=cur^.left;
+  end;
+  FindLess:=x;
+end;
+
+function TSet.FindLessEqual(value:T):PNode;inline;
+var x,cur:PNode;
+begin
+  x:=nil;
+  cur:=FBase;
+  while (cur <> nil) do begin
+    if (not TCompare.c(value, cur^.data)) then
+    begin
+      x:=cur;
+      cur:=cur^.right;
+    end else
+      cur:=cur^.left;
+  end;
+  FindLessEqual:=x;
+end;
+
+function TSet.FindGreater(value:T):PNode;inline;
+var x,cur:PNode;
+begin
+  x:=nil;
+  cur:=FBase;
+  while (cur <> nil) do begin
+    if (TCompare.c(value, cur^.Data)) then
+    begin
+      x:=cur;
+      cur:=cur^.left;
+    end else
+      cur:=cur^.right;
+  end;
+  FindGreater:=x;
+end;
+
+function TSet.FindGreaterEqual(value:T):PNode;inline;
+var x,cur:PNode;
+begin
+  x:=nil;
+  cur:=FBase;
+  while (cur <> nil) do begin
+    if (not TCompare.c(cur^.Data, value)) then
+    begin
+      x:=cur;
+      cur:=cur^.left;
+    end else
+      cur:=cur^.right;
+  end;
+  FindGreaterEqual:=x;
+end;
+
+function TSet.Insert(value:T):PNode;inline;
+var position:PNode;
+begin
+  FBase:=Insert(value, FBase, position);
+  FBase^.Color:=BLACK;
+  Insert:=position;
+end;
+
+function TSet.Insert(value:T; nod:PNode; var position:PNode):PNode;
+begin
+  if(nod=nil) then begin
+    nod:=CreateNode(value);
+    position:=nod;
+    exit(nod);
+  end;
+  if(TCompare.c(value,nod^.Data)) then begin 
+    nod^.Left:=Insert(value, nod^.Left, position);
+    nod^.Left^.Parent:=nod; 
+  end
+  else if TCompare.c(nod^.Data,value) then begin 
+    nod^.Right:=Insert(value, nod^.Right, position);
+    nod^.Right^.Parent:=nod;
+  end
+  else begin
+    position:=nod;
+    exit(nod);
+  end;
+
+  if(IsRed(nod^.Right)) and (not IsRed(nod^.Left)) then nod := rotateLeft(nod);
+  if(IsRed(nod^.Left)) and (IsRed(nod^.Left^.Left)) then nod := rotateRight(nod);
+  if(IsRed(nod^.Right)) and (IsRed(nod^.Left)) then flipColors(nod);
+  
+  Insert:=nod;
+end;
+
+function TSet.IsRed(nod:PNode):boolean;inline;
+begin
+  if(nod=nil) then exit(false);
+  exit(nod^.Color);
+end;
+
+function TSet.Min(nod:PNode):PNode;inline;
+var temp:PNode;
+begin
+  temp:=nod;
+  while(temp^.Left<>nil) do temp:=temp^.Left;
+  exit(temp);
+end;
+
+function TSet.Min:PNode;inline;
+begin
+  if FBase=nil then exit(nil);
+  Min:=Min(FBase);
+end;
+
+function TSet.Max:PNode;inline;
+var temp:PNode;
+begin
+  if FBase=nil then exit(nil);
+  temp:=FBase;
+  while(temp^.Right<>nil) do temp:=temp^.Right;
+  exit(temp);
+end;
+
+function TSet.Next(x:PNode):PNode;inline;
+var temp:PNode;
+begin
+  if(x=nil) then exit(nil);
+  if(x^.Right<>nil) then begin
+    temp:=x^.Right;
+    while(temp^.Left<>nil) do temp:=temp^.Left;
+  end
+  else begin
+    temp:=x;
+    while(true) do begin
+      if(temp^.Parent=nil) then begin temp:=temp^.Parent; break; end;
+      if(temp^.Parent^.Left=temp) then begin temp:=temp^.Parent; break; end;
+      temp:=temp^.Parent;
+    end;
+  end;
+  exit(temp);
+end;
+
+function TSet.Prev(x:PNode):PNode;inline;
+var temp:PNode;
+begin
+  if(x=nil) then exit(nil);
+  if(x^.Left<>nil) then begin
+    temp:=x^.Left;
+    while(temp^.Right<>nil) do temp:=temp^.Right;
+  end
+  else begin
+    temp:=x;
+    while(true) do begin
+      if(temp^.Parent=nil) then begin temp:=temp^.Parent; break; end;
+      if(temp^.Parent^.Right=temp) then begin temp:=temp^.Parent; break; end;
+      temp:=temp^.Parent;
+    end;
+  end;
+  exit(temp);
+end;
+
+end.
diff --git a/packages/fcl-stl/src/gstack.pp b/packages/fcl-stl/src/gstack.pp
new file mode 100644
index 0000000000..2d5cfe4020
--- /dev/null
+++ b/packages/fcl-stl/src/gstack.pp
@@ -0,0 +1,73 @@
+{
+   This file is part of the Free Pascal FCL library.
+   BSD parts (c) 2011 Vlado Boza
+
+   See the file COPYING.FPC, included in this distribution,
+   for details about the copyright.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY;without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+**********************************************************************}
+{$mode objfpc}
+
+unit gstack;
+
+interface
+
+uses gvector;
+
+type 
+  generic TStack<T>=class
+    private
+    type TContainer= specialize TVector<T>;
+    var FData:TContainer;
+    public
+    procedure Push(x:T);inline;
+    procedure Pop();inline;
+    function Top():T;inline;
+    function Size():longint;inline;
+    function IsEmpty():boolean;inline;
+    constructor Create;
+    destructor Destroy;override;
+end;
+
+implementation
+
+constructor TStack.Create;
+begin
+  FData:=TContainer.Create;
+end;
+
+destructor TStack.Destroy;
+begin
+  FData.Destroy;
+end;
+
+procedure TStack.Push(x:T);inline;
+begin
+  FData.PushBack(x);
+end;
+
+procedure TStack.Pop;inline;
+begin
+  FData.PopBack;
+end;
+
+function TStack.Top:T;inline;
+begin
+  Top:=FData.Back;
+end;
+
+function TStack.Size:longint;inline;
+begin
+  Size:=FData.Size;
+end;
+
+function TStack.IsEmpty:boolean;inline;
+begin
+  IsEmpty:=FData.IsEmpty;
+end;
+
+end.
diff --git a/packages/fcl-stl/src/gutil.pp b/packages/fcl-stl/src/gutil.pp
new file mode 100644
index 0000000000..f653940f2b
--- /dev/null
+++ b/packages/fcl-stl/src/gutil.pp
@@ -0,0 +1,39 @@
+{
+   This file is part of the Free Pascal FCL library.
+   BSD parts (c) 2011 Vlado Boza
+
+   See the file COPYING.FPC, included in this distribution,
+   for details about the copyright.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY;without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+**********************************************************************}
+{$mode objfpc}
+
+unit gutil;
+
+interface
+
+type generic TLess<T>=class
+  class function c(a,b:T):boolean;inline;
+end;
+
+type generic TGreater<T>=class
+  class function c(a,b:T):boolean;inline;
+end;
+
+implementation
+
+class function TLess.c(a,b:T):boolean;inline;
+begin
+  c:=a<b;
+end;
+
+class function TGreater.c(a,b:T):boolean;inline;
+begin
+  c:=b<a;
+end;
+
+end.
diff --git a/packages/fcl-stl/src/gvector.pp b/packages/fcl-stl/src/gvector.pp
new file mode 100644
index 0000000000..96fb6bce76
--- /dev/null
+++ b/packages/fcl-stl/src/gvector.pp
@@ -0,0 +1,173 @@
+{
+   This file is part of the Free Pascal FCL library.
+   BSD parts (c) 2011 Vlado Boza
+
+   See the file COPYING.FPC, included in this distribution,
+   for details about the copyright.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY;without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+**********************************************************************}
+{$mode objfpc}
+
+unit gvector;
+
+interface
+
+type
+  generic TVector<T>=class
+  private
+  type
+    PT=^ T;
+    TArr=array of T;
+  var
+    FCapacity:SizeUInt;
+    FDataSize:SizeUInt;
+    FData:TArr;
+
+    procedure SetValue(Position:SizeUInt; Value:T);inline;
+    function GetValue(Position:SizeUInt):T;inline;
+    function GetMutable(Position:SizeUInt):PT;inline;
+    procedure IncreaseCapacity;inline;
+  public
+    constructor Create;
+    function Size:SizeUInt;inline;
+    procedure PushBack(Value:T);inline;
+    procedure PopBack;inline;
+    function IsEmpty:boolean;inline;
+    procedure Insert(Position:SizeUInt; Value:T);inline;
+    procedure Erase(Position:SizeUInt);inline;
+    procedure Clear;inline;
+    function Front:T;inline;
+    function Back:T;inline;
+    procedure Reserve(Num:SizeUInt);inline;
+    procedure Resize(Num:SizeUInt);inline;
+
+    property Items[i : SizeUInt]: T read getValue write setValue; default;
+    property Mutable[i : SizeUInt]: PT read getMutable;
+end;
+
+implementation
+
+constructor TVector.Create();
+begin
+  FCapacity:=0;
+  FDataSize:=0;
+end;
+
+procedure TVector.SetValue(Position:SizeUInt; Value:T);inline;
+begin
+  Assert(position < size, 'Vector position out of range');
+  FData[Position]:=Value;
+end;
+
+function TVector.GetValue(Position:SizeUInt):T;inline;
+begin
+  Assert(position < size, 'Vector position out of range');
+  GetValue:=FData[Position];
+end;
+
+function TVector.GetMutable(Position:SizeUInt):PT;inline;
+begin
+  Assert(position < size, 'Vector position out of range');
+  GetMutable:=@FData[Position];
+end;
+
+function TVector.Front():T;inline;
+begin
+  Assert(size > 0, 'Accessing element of empty vector');
+  Front:=FData[0];
+end;
+
+function TVector.Back():T;inline;
+begin
+  Assert(size > 0, 'Accessing element of empty vector');
+  Back:=FData[FDataSize-1];
+end;
+
+function TVector.Size():SizeUInt;inline;
+begin
+  Size:=FDataSize;
+end;
+
+function TVector.IsEmpty():boolean;inline;
+begin
+  if Size()=0 then 
+    IsEmpty:=true
+  else 
+    IsEmpty:=false;
+end;
+
+procedure TVector.PushBack(Value:T);inline;
+begin
+  if FDataSize=FCapacity then
+    IncreaseCapacity;
+  FData[FDataSize]:=Value;
+  inc(FDataSize);
+end;
+
+procedure TVector.IncreaseCapacity();inline;
+begin
+  if FCapacity=0 then
+    FCapacity:=1
+  else
+    FCapacity:=FCapacity*2;
+  SetLength(FData, FCapacity);
+end;
+
+procedure TVector.PopBack();inline;
+begin
+  if FDataSize>0 then
+    FDataSize:=FDataSize-1;
+end;
+
+procedure TVector.Insert(Position:SizeUInt; Value: T);inline;
+var i:SizeUInt;
+begin
+  pushBack(Value);
+  for i:=Size-1 downto Position+1 do 
+  begin
+    FData[i]:=FData[i-1];
+  end;
+  FData[Position]:=Value;
+end;
+
+procedure TVector.Erase(Position:SizeUInt);inline;
+var i:SizeUInt;
+begin
+  if Position <= Size then 
+  begin
+    for i:=Position to Size-2 do
+    begin
+      FData[i]:=FData[i+1];
+    end;
+    popBack();
+  end;
+end;
+
+procedure TVector.Clear;inline;
+begin
+  FDataSize:=0;
+end;
+
+procedure TVector.Reserve(Num:SizeUInt);inline;
+begin
+  if(Num < FCapacity) then 
+    exit
+  else if(Num <= 2*FCapacity) then 
+    IncreaseCapacity
+  else begin 
+    SetLength(FData, Num);
+    FCapacity:=Num;
+  end;
+end;
+
+procedure TVector.Resize(Num:SizeUInt);inline;
+begin
+  Reserve(Num);
+  FDataSize:=Num;
+end;
+
+end.