lazarus-src-0.9.30.4 0.9.30.4-6 / usr / lib / lazarus / 0.9.30.4 / lcl / maps.pp

{ $Id: maps.pp 24281 2010-03-29 11:51:36Z marc $ }
{
 *****************************************************************************
 *                                                                           *
 *  This file is part of the Lazarus Component Library (LCL)                 *
 *                                                                           *
 *  See the file COPYING.modifiedLGPL.txt, 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.                     *
 *                                                                           *
 *****************************************************************************

  Author: Marc Weustink

  Abstract:
    The Map maps an unique ID to arbitrary data. The ID->Data is stored in a
    Average Level binary Tree for fast indexing.
    The map maintans also a linked list beween the ordered items for fast
    iterating through all elements.
    The ID can be signed or unsigned, with a size of 1,2,4,8,16 or 32 bytes
    The data can be of any (constant) size.
}
unit maps;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Math, FPCAdds, AvgLvlTree, typinfo;
  
type
  TMapIdType = (itu1, its1, itu2, its2, itu4, its4, itu8, its8, itu16, its16,
                itu32, its32);

const
  {$ifdef CPU64}
  itsPtrSize = its8;
  ituPtrSize = itu8;
  {$else}
  itsPtrSize = its4;
  ituPtrSize = itu4;
  {$endif}

type
  PMapItem = ^TMapItem;

  PMapLink = ^TMapLink;
  TMapLink = record
    Previous, Next: PMapItem;
  end;

  PMapID = ^TMapID;
  TMapID = record
    case TMapIdType of
      itu1: (U1: Byte);
      its1: (S1: ShortInt);
      itu2: (U2: Word);
      its2: (S2: SmallInt);
      itu4: (U4: LongWord);
      its4: (S4: LongInt);
      itu8: (U8: QWord);
      its8: (S8: Int64);
      {$IFDEF ENDIAN_LITTLE}
      itu16: (U16L: QWord; U16H: QWord);
      its16: (S16L: QWord; S16H: Int64);
      itu32: (U32LL: QWord; U32LH: QWord; U32HL: QWord; U32HH: QWord);
      its32: (S32LL: QWord; S32LH: QWord; S32HL: QWord; S32HH: Int64);
      {$ELSE}
      itu16: (U16H: QWord; U16L: QWord);
      its16: (S16H: Int64; S16L: QWord);
      itu32: (U32HH: QWord; U32HL: QWord; U32LH: QWord; U32LL: QWord);
      its32: (S32HH: Int64; S32HL: QWord; S32LH: QWord; S32LL: QWord);
      {$ENDIF}
  end;

  TMapItem = packed record
    Link: TMapLink;
    ID: TMapID
    { Data: record end; }
    { Data follows imediately }
  end;
  
  { TBaseMap }
  
  TBaseMapIterator = class;

  TBaseMap = class(TPersistent)
  private
    FTree: TAvgLvlTree;
    FIdType: TMapIdType;
    FDataSize: Cardinal;
    FFirst: PMapItem;   // First element of our linkedlist
    FLast: PMapItem;    // Last element of our linkedlist
    FIterators: TList;  // A List of iterators iterating us
    function FindNode(const AId): TAvgLvlTreeNode;
    function FindItem(const AId): PMapItem;
    procedure FreeData(ANode: TAvgLvlTreeNode);
    function TreeCompareID(Sender: TAvgLvlTree; AItem1, AItem2: Pointer): Integer;
    //--
    procedure IteratorAdd(AIterator: TBaseMapIterator);
    procedure IteratorRemove(AIterator: TBaseMapIterator);
  protected
    procedure InternalAdd(const AId, AData);
    function InternalGetData(AItem: PMapItem; out AData): Boolean;
    function InternalGetDataPtr(AItem: PMapItem): Pointer;
    function InternalGetId(AItem: PMapItem; out AID): Boolean;
    function InternalSetData(AItem: PMapItem; const AData): Boolean;
    procedure ReleaseData(ADataPtr: Pointer); virtual;
  public
    constructor Create(AIdType: TMapIdType; ADataSize: Cardinal);
    procedure Clear;
    function Count: Integer;
    function Delete(const AId): Boolean;
    destructor Destroy; override;
  end;
  
  { TBaseMapIterator }

  TBaseMapIterator = class(TObject)
  private
    FMap: TBaseMap;
    FCurrent: PMapItem;
    FInValid: Boolean;           // Set if our current is removed or when a locate failed, in those cases current is next
                                 // will be set to next
    FBOM: Boolean;               // Begin Of Map
    FEOM: Boolean;               // End Of Map
    procedure MapDestroyed;      // Called when our map is destroyed
    procedure MapCleared;        // Called when our map is cleared
    procedure ItemRemove(AData: Pointer); // Called when an Item is removed from the map
  protected
    procedure InternalCreate(AMap: TBaseMap);
    function InternalLocate(const AId): Boolean; //True if match found. If not found, current is next and Invalid is set
    procedure Validate;
    procedure ValidateMap;
    property Current: PMapItem read FCurrent;
  public
    destructor Destroy; override;
    procedure First;
    procedure Next;
    procedure Previous;
    procedure Last;
    function Valid: Boolean;     // false if our map is gone

    property BOM: Boolean read FBOM;
    property EOM: Boolean read FEOM;
  end;
  
  { TMap }

  TMap = class(TBaseMap)
  private
  protected
  public
    procedure Add(const AId, AData);
    function HasId(const AID): Boolean;
    function GetData(const AId; out AData): Boolean;
    function GetDataPtr(const AId): Pointer;
    function SetData(const AId, AData): Boolean;
  end;
  
  { TMapIterator }

  TMapIterator = class(TBaseMapIterator)
  private
  protected
  public
    constructor Create(AMap: TMap);
    function  DataPtr: Pointer;
    procedure GetData(out AData);
    procedure GetID(out AID);
    function  Locate(const AId): Boolean;
    procedure SetData(const AData);
  end;

  { TTypedMap }

  TTypedMap = class(TBaseMap)
  private
    FTypeInfo: POinter;
  protected
    function InternalSetData(AItem: PMapItem; const AData): Boolean;
    procedure ReleaseData(ADataPtr: Pointer); override;
  public
    procedure Add(const AId, AData);
    constructor Create(AIdType: TMapIdType; ATypeInfo: PTypeInfo);
    destructor Destroy; override;
    function HasId(const AID): Boolean;
    function GetData(const AId; out AData): Boolean;
    function GetDataPtr(const AId): Pointer;
    function SetData(const AId, AData): Boolean;
  end;

  { TTypedMapIterator }

  TTypedMapIterator = class(TBaseMapIterator)
  private
  protected
  public
    constructor Create(AMap: TTypedMap);
    procedure GetData(out AData);
    procedure GetID(out AID);
    function  Locate(const AId): Boolean;
    procedure SetData(const AData);
  end;

  
function MapReport(AMap: TBaseMap): String;

implementation

const
  DUPLICATE_ID = 'Duplicate ID: %s';
  
const
  ID_LENGTH: array[TMapIdType] of Byte = (1,1,2,2,4,4,8,8,16,16,32,32);


function MapReport(AMap: TBaseMap): String;
begin
  if (AMap = nil) or (AMap.FTree = nil)
  then Result := ''
  else Result := AMap.FTree.ReportAsString;
end;


{ TBaseMap }

procedure TBaseMap.Clear;
var
  n: Integer;
begin
  FreeData(FTree.Root);
  FTree.Clear;
  FFirst := nil;
  FLast := nil;
  
  // notify our iterators
  if FIterators <> nil
  then begin
    for n := 0 to FIterators.Count - 1 do
      TBaseMapIterator(FIterators[n]).MapCleared;
  end;
end;

function TBaseMap.Count: Integer;
begin
  Result := FTree.Count;
end;

constructor TBaseMap.Create(AIdType: TMapIdType; ADataSize: Cardinal);
begin
  inherited Create;
  FIdType := AIdType;
  FDataSize := ADataSize;
  FTree := TAvgLvlTree.CreateObjectCompare(@TreeCompareID);
end;

function TBaseMap.Delete(const AId): Boolean;
var
  Node: TAvgLvlTreeNode;
  n: integer;
begin
  Node := FindNode(AId);
  Result := Node <> nil;
  if not result then Exit;
  
  // Remove from linked list
  if PMapItem(Node.Data)^.Link.Next = nil //we were last
  then FLast := PMapItem(Node.Data)^.Link.Previous
  else PMapItem(Node.Data)^.Link.Next^.Link.Previous := PMapItem(Node.Data)^.Link.Previous;
  if PMapItem(Node.Data)^.Link.Previous = nil //we were fist
  then FFirst := PMapItem(Node.Data)^.Link.Next
  else PMapItem(Node.Data)^.Link.Previous^.Link.Next := PMapItem(Node.Data)^.Link.Next;

  // CheckIterators
  if FIterators <> nil
  then begin
    for n := 0 to FIterators.Count - 1 do
      TBaseMapIterator(FIterators[n]).ItemRemove(Node.Data);
  end;

  ReleaseData(InternalGetDataPtr(Node.Data));
  FreeMem(Node.Data);
  FTree.Delete(Node);
end;

destructor TBaseMap.Destroy;
var
  n: Integer;
begin
  // notify our iterators
  if FIterators <> nil
  then begin
    for n := 0 to FIterators.Count - 1 do
      TBaseMapIterator(FIterators[n]).MapDestroyed;
  end;

  FreeData(FTree.Root);
  FTree.Clear;
  FreeAndNil(FTree);
  inherited Destroy;
end;

function TBaseMap.FindItem(const AId): PMapItem;
var
  Node: TAvgLvlTreeNode;
begin
  Node := FindNode(AId);
  if Node = nil
  then Result := nil
  else Result := Node.Data;
end;

function TBaseMap.FindNode(const AId): TAvgLvlTreeNode;
var
  Item: TMapItem;
begin
  Move(AID, Item.ID, ID_LENGTH[FIdType]);
  Result := FTree.Find(@Item);
end;

procedure TBaseMap.FreeData(ANode: TAvgLvlTreeNode);
begin
  if ANode = nil then Exit;
  FreeData(ANode.Left);
  FreeData(ANode.Right);
  ReleaseData(InternalGetDataPtr(ANode.Data));
  FreeMem(ANode.Data);
end;

procedure TBaseMap.InternalAdd(const AId, AData);
  procedure Error;
  const
    a: PChar =  '0123456789ABCDEF';
  var
    n: Integer;
    S: String;
    p: PByte;
  begin
    SetLength(S, ID_LENGTH[FIdType] * 2);
    {$IFDEF ENDIAN_BIG}
    p := @AId;
    {$ELSE}
    p := @AId + ID_LENGTH[FIdType] - 1;
    {$ENDIF}
    for n := 1 to ID_LENGTH[FIdType] do
    begin
      S[2 * n - 1] := a[(p^ shr 4) and $F];
      S[2 * n] := a[p^ and $F];
      {$IFDEF ENDIAN_BIG}
      Inc(p);
      {$ELSE}
      Dec(p);
      {$ENDIF}
    end;

    raise EListError.CreateFmt(DUPLICATE_ID, [S]);
  end;
var
  item: PMapItem;
  p: Pointer;
  Node, NewNode: TAvgLvlTreeNode;
begin
  if FindNode(AId) <> nil
  then begin
    Error;
    Exit;
  end;

  Item := GetMem(SizeOF(TMapLink) + cardinal(ID_LENGTH[FIdType]) + FDataSize);
  p := @item^.ID;
  Move(AId, p^, ID_LENGTH[FIdType]);
  inc(p, ID_LENGTH[FIdType]);
  Move(Adata, p^, FDataSize);
  NewNode := FTree.Add(item);

  // Update linked list
  Node := FTree.FindPrecessor(NewNode);
  if Node = nil
  then begin
    // no previous node
    FFirst := Item;
    Node := FTree.FindSuccessor(NewNode);
    Item^.Link.Previous := nil;
    if Node = nil
    then begin
      // We're the only one
      Item^.Link.Next := nil;
      FLast := Item;
    end
    else begin
      Item^.Link.Next := Node.Data;
      PMapItem(Node.Data)^.Link.Previous := Item;
    end;
  end
  else begin
    // there is a prevous node
    Item^.Link.Previous := Node.Data;
    Item^.Link.Next := PMapItem(Node.Data)^.Link.Next;
    PMapItem(Node.Data)^.Link.Next := Item;
    if Item^.Link.Next = nil // no item after us, so we're last
    then FLast := Item
    else Item^.Link.Next^.Link.Previous := Item;
  end;
end;

function TBaseMap.InternalGetData(AItem: PMapItem; out AData): Boolean;
var
  p: Pointer;
begin
  Result := AItem <> nil;
  if not result then Exit;

  p := @AItem^.ID;
  Inc(p, ID_LENGTH[FIdType]);
  Move(p^, AData, FDataSize);
end;

function TBaseMap.InternalGetDataPtr(AItem: PMapItem): Pointer;
begin
  if AItem = nil
  then begin
    Result := nil;
    Exit;
  end;
  
  Result := @AItem^.ID;
  Inc(Result, ID_LENGTH[FIdType]);
end;

function TBaseMap.InternalGetId(AItem: PMapItem; out AID): Boolean;
begin
  Result := AItem <> nil;
  if not Result then Exit;

  Move(AItem^.ID, AID, ID_LENGTH[FIdType]);
end;

function TBaseMap.InternalSetData(AItem: PMapItem; const AData): Boolean;
var
  p: Pointer;
begin
  Result := AItem <> nil;
  if not Result then Exit;

  p := @AItem^.ID;
  Inc(p, ID_LENGTH[FIdType]);
  Move(AData, p^, FDataSize);
end;

procedure TBaseMap.IteratorAdd(AIterator: TBaseMapIterator);
begin
  if FIterators = nil then FIterators := TList.Create;
  FIterators.Add(AIterator);
end;

procedure TBaseMap.IteratorRemove(AIterator: TBaseMapIterator);
begin
  if FIterators = nil then Exit;
  FIterators.Remove(AIterator);
  if FIterators.Count = 0 then FreeAndNil(FIterators);
end;

procedure TBaseMap.ReleaseData(ADataPtr: Pointer);
begin
end;

function TBaseMap.TreeCompareID(Sender: TAvgLvlTree; AItem1, AItem2: Pointer): Integer;
var
  Item1: PMapItem absolute AItem1;
  Item2: PMapItem absolute AItem2;
begin
  case FIdType of
    itu1: Result := CompareValue(Item1^.ID.U1, Item2^.ID.U1);
    its1: Result := CompareValue(Item1^.ID.S1, Item2^.ID.S1);
    itu2: Result := CompareValue(Item1^.ID.U2, Item2^.ID.U2);
    its2: Result := CompareValue(Item1^.ID.S2, Item2^.ID.S2);
    itu4: Result := CompareValue(Item1^.ID.U4, Item2^.ID.U4);
    its4: Result := CompareValue(Item1^.ID.S4, Item2^.ID.S4);
    itu8: Result := CompareValue(Item1^.ID.U8, Item2^.ID.U8);
    its8: Result := CompareValue(Item1^.ID.S8, Item2^.ID.S8);
    itu16: begin
      Result := CompareValue(Item1^.ID.U16H, Item2^.ID.U16H);
      if Result = 0
      then Result := CompareValue(Item1^.ID.U16L, Item2^.ID.U16L);
    end;
    its16: begin
      Result := CompareValue(Item1^.ID.S16H, Item2^.ID.S16H);
      if Result = 0
      then Result := CompareValue(Item1^.ID.S16L, Item2^.ID.S16L);
    end;
    itu32: begin
      Result := CompareValue(Item1^.ID.U32HH,Item2^.ID.U32HH);
      if Result = 0
      then Result := CompareValue(Item1^.ID.U32HL, Item2^.ID.U32HL);
      if Result = 0
      then Result := CompareValue(Item1^.ID.U32LH, Item2^.ID.U32LH);
      if Result = 0
      then Result := CompareValue(Item1^.ID.U32LL, Item2^.ID.U32LL);
    end;
    its32: begin
      Result := CompareValue(Item1^.ID.S32HH, Item2^.ID.S32HH);
      if Result = 0
      then Result := CompareValue(Item1^.ID.S32HL, Item2^.ID.S32HL);
      if Result = 0
      then Result := CompareValue(Item1^.ID.S32LH, Item2^.ID.S32LH);
      if Result = 0
      then Result := CompareValue(Item1^.ID.S32LL, Item2^.ID.S32LL);
    end;
  end;
end;

{ TBaseMapIterator }


destructor TBaseMapIterator.Destroy;
begin
  if FMap <> nil then FMap.IteratorRemove(Self);
  FMap := nil;
  inherited Destroy;
end;

procedure TBaseMapIterator.First;
begin
  if FMap = nil then Exit;
  FCurrent := FMap.FFirst;
  FBOM := FCurrent = nil;
  FEOM := FCurrent = nil;
end;

procedure TBaseMapIterator.InternalCreate(AMap: TBaseMap);
begin
  inherited Create;
  FMap := AMap;
  FMap.IteratorAdd(Self);
  FCurrent := FMap.FFirst;
  FBOM := FCurrent = nil;
  FEOM := FCurrent = nil;
end;

function TBaseMapIterator.InternalLocate(const AId): Boolean;
var
  C: Integer;
  Node, LastNext: TAvgLvlTreeNode;
  Item: TMapItem;
begin
  ValidateMap;
  
  FInvalid := True;

  Node := FMap.FTree.Root;
  if Node <> nil
  then begin
    Move(AID, Item.ID, ID_LENGTH[FMap.FIdType]);
    LastNext := nil;
    while True do
    begin
      C := FMap.TreeCompareID(nil, @Item, Node.Data);
      if C = 0
      then begin
        FInvalid := False;
        Break;
      end;
      if C < 0
      then begin
        if Node.Left = nil then Break; // no smaller node so we're at next best
        LastNext := Node;
        Node := Node.Left;
      end
      else begin
        Node := Node.Right; // try a bigger one
        if Node = nil
        then begin
          Node := LastNext;
          Break; // not larger
        end;
      end;
    end;
  end;

  if Node = nil
  then begin
    FEOM := True;
    FCurrent := FMap.FLast;
    FBOM := FCurrent = nil;
  end
  else begin
    FCurrent := Node.Data;
    FBOM := FCurrent = nil;
    FEOM := FCurrent = nil;
  end;
  Result := not FInvalid;
end;

procedure TBaseMapIterator.ItemRemove(AData: Pointer);
begin
  if AData <> FCurrent then Exit;
  FInvalid := True;
  FCurrent := FCurrent^.Link.Next;
  FEOM := FCurrent = nil;
end;

procedure TBaseMapIterator.Last;
begin
  if FMap = nil then Exit;
  FCurrent := FMap.FLast;
  FEOM := FCurrent = nil;
  FBOM := FCurrent = nil;
end;

procedure TBaseMapIterator.MapCleared;
begin
  FCurrent := nil;
  FBOM := True;
  FEOM := True;
  FInvalid := False;
end;

procedure TBaseMapIterator.MapDestroyed;
begin
  FMap := nil;
  FCurrent := nil;
  FBOM := True;
  FEOM := True;
  FInvalid := False;
end;

procedure TBaseMapIterator.Next;
  procedure Error;
  begin
    raise EInvalidOperation.Create('Cannot move past end');
  end;
begin
  if FInvalid
  then begin
    // We are already at the next
    FInvalid := False;
    Exit;
  end;
  if FEOM then Error;

  if FBOM then
  begin
    // Get first element
    FCurrent := FMap.FFirst;
    FBOM := FCurrent = nil;
  end
  else begin
    FCurrent := FCurrent^.Link.Next;
  end;
  
  FEOM := FCurrent = nil
end;

procedure TBaseMapIterator.Previous;
  procedure Error;
  begin
    raise EInvalidOperation.Create('Cannot move before start');
  end;
begin
  if FBOM then Error;
  FInvalid := False;

  if FEOM then
  begin
    // Get last element
    FCurrent := FMap.FLast;
    FEOM := FCurrent = nil
  end
  else begin
    FCurrent := FCurrent^.Link.Previous;
  end;

  FBOM := FCurrent = nil
end;

function TBaseMapIterator.Valid: Boolean;
begin
  Result := FMap <> nil;
end;

procedure TBaseMapIterator.Validate;
begin
  ValidateMap;

  if FCurrent = nil
  then raise EInvalidOperation.Create('No current item');
  
  if FInvalid
  then raise EInvalidOperation.Create('Current item removed');
end;

procedure TBaseMapIterator.ValidateMap;
begin
  if FMap = nil
  then raise EInvalidOperation.Create('Map destroyed');
end;

{ TMap }

procedure TMap.Add(const AId, AData);
begin
  InternalAdd(AId, AData);
end;

function TMap.GetData(const AId; out AData): Boolean;
begin
  Result := InternalGetData(FindItem(AId), AData);
end;

function TMap.GetDataPtr(const AId): Pointer;
begin
  Result := InternalGetDataPtr(FindItem(AId));
end;

function TMap.HasId(const AID): Boolean;
begin
  Result := FindNode(AId) <> nil;
end;


function TMap.SetData(const AId, AData): Boolean;
begin
  Result := InternalSetData(FindItem(AId), AData);
end;

{ TTypedMap }

// some hack to get access to fpc internals
procedure fpc_AddRef(Data, TypeInfo: Pointer); external name 'FPC_ADDREF';
procedure fpc_DecRef(Data, TypeInfo: Pointer); external name 'FPC_DECREF';

procedure TTypedMap.Add(const AId, AData);
begin
  InternalAdd(AId, AData);
  fpc_AddRef(@Adata, FtypeInfo);
end;

constructor TTypedMap.Create(AIdType: TMapIdType; ATypeInfo: PTypeInfo);
var
  Size: Integer;
  TypeData: PTypeData;
begin
  TypeData := GetTypedata(ATypeInfo);
  case ATypeInfo^.Kind of
    tkLString, tkAString, tkWString, tkInterface, tkDynArray, tkClass: begin
      Size := SizeOf(Pointer);
    end;

    tkInteger, tkEnumeration, tkSet, tkWChar, tkChar: begin
      case TypeData^.OrdType of
        otSByte, otUByte: Size := SizeOf(Byte);
        otSWord, otUWord: Size := SizeOf(Word);
        otSLong, otULong: Size := SizeOf(LongWord);
      else
        Size := 0;
      end;
    end;

    tkMethod : Size := SizeOf(TMethod);
    tkVariant: Size := SizeOf(TVarData);
    tkInt64  : Size := SizeOf(Int64);
    tkQWord  : Size := SizeOf(QWord);
    tkBool   : Size := SizeOf(Boolean);

    tkFloat: begin
      case TypeData^.FloatType of
        ftSingle   : Size := SizeOf(Single);
        ftDouble   : Size := SizeOf(Double);
        ftExtended : Size := SizeOf(Extended);
        ftComp     : Size := SizeOf(Comp);
        ftCurr     : Size := SizeOf(Currency);
      else
        Size := 0;
      end;
    end;

    tkSString: Size := TypeData^.MaxLength;
    tkArray  : Size := PInteger(TypeData)[0] * PInteger(TypeData)[1];
    tkRecord,
    tkObject : Size := PInteger(TypeData)[0];
  else
    Size := 0;
  end;

  if Size = 0 then raise EInvalidOperation.Create('Type must have a size');

  FTypeInfo := ATypeInfo;
  inherited Create(AIdType, Size);
end;

destructor TTypedMap.Destroy;
begin
  inherited Destroy;
end;

function TTypedMap.GetData(const AId; out AData): Boolean;
begin
  Result := InternalGetData(FindItem(AId), AData);
  if Result
  then fpc_AddRef(@Adata, FtypeInfo);
end;

function TTypedMap.GetDataPtr(const AId): Pointer;
begin
  Result := InternalGetDataPtr(FindItem(AId));
end;

function TTypedMap.HasId(const AID): Boolean;
begin
  Result := FindNode(AId) <> nil;
end;

function TTypedMap.InternalSetData(AItem: PMapItem; const AData): Boolean;
var
  Data: Pointer;
begin
  // copy data first to allow Map[ID] := Map[ID]
  GetMem(Data, FDataSize);
  InternalGetData(AItem, Data^);

  Result := inherited InternalSetData(AItem, AData);
  if not Result then Exit;

  fpc_AddRef(@AData, FtypeInfo);
  fpc_DecRef(Data, FTypeInfo);
  FreeMem(Data);
end;

procedure TTypedMap.ReleaseData(ADataPtr: Pointer);
begin
  fpc_DecRef(ADataPtr, FTypeInfo);
end;

function TTypedMap.SetData(const AId, AData): Boolean;
var
  Item: PMapItem;
begin
  Item := FindItem(AId);
  Result := Item <> nil;
  if not Result then Exit;
  InternalSetData(Item, AData);
end;

{ TMapIterator }

constructor TMapIterator.Create(AMap: TMap);
begin
  InternalCreate(AMap);
end;

function TMapIterator.DataPtr: Pointer;
begin
  Validate;
  Result:=FMap.InternalGetDataPtr(FCurrent);
end;

procedure TMapIterator.GetData(out AData);
begin
  Validate;
  FMap.InternalGetData(FCurrent, AData);
end;

procedure TMapIterator.GetID(out AID);
begin
  Validate;
  FMap.InternalGetId(FCurrent, AId);
end;

function TMapIterator.Locate(const AId): Boolean;
begin
  Result := InternalLocate(AID);
end;

procedure TMapIterator.SetData(const AData);
begin
  Validate;
  FMap.InternalSetData(FCurrent, AData);
end;

{ TTypedMapIterator }

constructor TTypedMapIterator.Create(AMap: TTypedMap);
begin
  InternalCreate(AMap);
end;

procedure TTypedMapIterator.GetData(out AData);
begin
  Validate;
  FMap.InternalGetData(FCurrent, AData);
  fpc_AddRef(@Adata, TTypedMap(FMap).FTypeInfo);
end;

procedure TTypedMapIterator.GetID(out AID);
begin
  Validate;
  FMap.InternalGetId(FCurrent, AId);
end;

function TTypedMapIterator.Locate(const AId): Boolean;
begin
  Result := InternalLocate(AID);
end;

procedure TTypedMapIterator.SetData(const AData);
begin
  Validate;
  TTypedMap(FMap).InternalSetData(FCurrent, AData);
end;

end.