ezdslhsh.pas

Eazy Data Structures library for Delphi.

end;
{--------}
function THashTable.Examine(const aKey : string) : pointer;
var
  Inx : integer;
begin
  if not htlFindPrim(aKey, Inx) then
    RaiseError(escKeyNotFound);
  Result := PHashElementArray(htlArray)^[Inx].heData;
end;
{--------}
procedure THashTable.htlDeletePrim(const aKey : string; AndErase : boolean);
var
  Inx : integer;
begin
  if not htlFindPrim(aKey, Inx) then
    RaiseError(escKeyNotFound);
  with PHashElementArray(htlArray)^[Inx] do begin
    if AndErase and IsDataOwner then
      DisposeData(heData);
    {$IFDEF Windows}
    DisposeStr(heString);
    {$ELSE}
    heString := '';
    {$ENDIF}
    heState := hesDeleted;
  end;
  dec(acCount);
  {if we have no elements left, quickly reset all elements to empty}
  if (Count = 0) then begin
    for Inx := 0 to pred(htlTableSize) do begin
      with PHashElementArray(htlArray)^[Inx] do
        heState := hesEmpty;
    end;
  end
  {shrink the table if we have some elements and we're under 1/6 full}
  else if (htlTableSize > MinTableSize) and
          ((Count * 6) < htlTableSize) then
    htlShrinkTable;
end;
{--------}
function THashTable.htlFindPrim(const aKey : string; var aIndex : integer) : boolean;
var
  FirstDeleted : integer;
  KeyHash      : integer;
  FirstKeyHash : integer;
begin
  {assume we'll fail}
  Result := false;
  {we may need to make note of the first deleted element we find, so
   set the variable to some impossible value so that we know whether
   we found one yet}
  FirstDeleted := -1;
  {calculate the hash for the string, make a note of it so we can find
   out when (if) we wrap around the table completely}
  KeyHash := htlHash(aKey);
  FirstKeyHash := KeyHash;
  {do forever - we'll be exiting out of the loop when needed}
  while true do begin
    {with the current element...}
    with PHashElementArray(htlArray)^[KeyHash] do
      case heState of
        hesEmpty   : begin
                       {the state is 'empty', we must stop the linear
                        probe and return either this index or the
                        first deleted one we encountered}
                       if (FirstDeleted <> -1) then
                         aIndex := FirstDeleted
                       else
                         aIndex := KeyHash;
                       Exit;
                     end;
        hesDeleted : begin
                       {the state is 'deleted', we must make a note of
                        this index if it's the first one we found and
                        continue the linear probe}
                       if (FirstDeleted = -1) then
                         FirstDeleted := KeyHash;
                     end;
        hesInUse   : begin
                       {the state is 'in use', we check to see if it's
                        our string, if it is, exit returning true and
                        the index}
                       if IgnoreCase then begin
                         {$IFDEF Windows}
                         if (AnsiCompareText(heString^, aKey) = 0) then begin
                         {$ELSE}
                         if (AnsiCompareText(heString, aKey) = 0) then begin
                         {$ENDIF}
                           aIndex := KeyHash;
                           Result := true;
                           Exit;
                         end;
                       end
                       else begin
                         {$IFDEF Windows}
                         if (heString^ = aKey) then begin
                         {$ELSE}
                         if (heString = aKey) then begin
                         {$ENDIF}
                           aIndex := KeyHash;
                           Result := true;
                           Exit;
                         end;
                       end;
                     end;
      else
        {bad news}
        RaiseError(escBadCaseSwitch);
      end;{case}
    {we didn't find the key or an empty slot this time around, so
     increment the index (taking care of the wraparound) and exit if
     we've got back to the start again}
    inc(KeyHash);
    if (KeyHash = htlTableSize) then
      KeyHash := 0;
    if (KeyHash = FirstKeyHash) then begin
      if (FirstDeleted <> -1) then
        aIndex := FirstDeleted
      else
        aIndex := -1; {this value means that the table is full}
      Exit;
    end;
  end;{forever loop}
end;
{--------}
procedure THashTable.htlGrowTable;
begin
  {make the table roughly twice as large as before}
  htlSetTableSize(htlTableSize * 2);
end;
{--------}
function THashTable.htlHash(const aKey : string) : integer;
var
  UCKey : string;
begin
  if not IgnoreCase then
    Result := htlHashFunc(aKey) mod htlTableSize
  else {ignore the case of characters} begin
    UCKey := AnsiUpperCase(aKey);
    Result := htlHashFunc(UCKey) mod htlTableSize;
  end;
  while (Result < 0) do                                        {!!.01}
    inc(Result, htlTableSize);                                 {!!.01}
end;
{--------}
procedure THashTable.htlMakeNewTable(aNewTableSize : integer);
var
  Inx          : integer;
  OldTableSize : integer;
  NewArray     : PHashElementArray;
  OldArray     : PHashElementArray;
  InUseCount   : integer;
begin
  {allocate a new array}
  GetMem(NewArray, aNewTableSize * sizeof(THashElement));
  FillChar(NewArray^, aNewTableSize * sizeof(THashElement), 0);
  {save the old array and element count and then set the object
   fields to the new values}
  OldArray := PHashElementArray(htlArray);
  OldTableSize := htlTableSize;
  htlArray := NewArray;
  htlTableSize := aNewTableSize;
  {save the actual count of InUse elements}
  InUseCount := Count;
  acCount := 0;
  {read through the old array and transfer over the strings/objects}
  for Inx := 0 to pred(OldTableSize) do begin
    with OldArray^[Inx] do begin
      if (heState = hesInUse) then begin
        {$IFDEF Windows}
        Insert(heString^, heData);
        DisposeStr(heString);
        {$ELSE}
        Insert(heString, heData);
        heString := '';
        {$ENDIF}
        dec(InUseCount);
        if (InUseCount = 0) then
          Break;
      end;
    end;
  end;
  {finally free the old array}
  FreeMem(OldArray, OldTableSize * sizeof(THashElement));
end;
{--------}
procedure THashTable.htlSetHashFunction(HF : THashFunction);
begin
  if Assigned(HF) then begin
    htlHashFunc := HF;
    htlMakeNewTable(htlTableSize);
  end;
end;
{--------}
procedure THashTable.htlSetIgnoreCase(IC : boolean);
begin
  if (htlIgnoreCase <> IC) then begin
    htlIgnoreCase := IC;
    htlMakeNewTable(htlTableSize);
  end;
end;
{--------}
procedure THashTable.htlSetTableSize(aNewTableSize : integer);
begin
  {force the hash table to be a prime at least MinTableSize, and if
   there's nothing to do, do it}
  aNewTableSize := GetClosestPrime(aNewTableSize);
  if (aNewTableSize < MinTableSize) then
    aNewTableSize := MinTableSize;
  if (aNewTableSize <> htlTableSize) then
    htlMakeNewTable(aNewTableSize);
end;
{--------}
procedure THashTable.htlShrinkTable;
begin
  {make the table roughly half as large as before}
  htlSetTableSize(htlTableSize div 2);
end;
{--------}
procedure THashTable.Insert(const aKey : string; aData : pointer);
var
  Inx : integer;
begin
  if htlFindPrim(aKey, Inx) then
    RaiseError(escInsertDup);
  if (Inx = -1) then
    RaiseError(escTableFull);
  with PHashElementArray(htlArray)^[Inx] do begin
    {$IFDEF Windows}
    heString := NewStr(aKey);
    {$ELSE}
    heString := aKey;
    {$ENDIF}
    heData := aData;
    heState := hesInUse;
  end;
  inc(acCount);
  {grow the table if we're over 2/3 full}
  if ((Count * 3) > (htlTableSize * 2)) then
    htlGrowTable;
end;
{--------}
function THashTable.Iterate(Action : TIterator; Backwards : boolean;
                            ExtraData : pointer) : pointer;
var
  Inx : integer;
begin
  Result := nil;
  if Backwards then begin
    for Inx := pred(htlTableSize) downto 0 do
      with PHashElementArray(htlArray)^[Inx] do begin
        if (heState = hesInUse) then
          if not Action(Self, heData, ExtraData) then begin
            Result := heData;
            Exit;
          end;
      end;
  end
  else {forwards} begin
    for Inx := 0 to pred(htlTableSize) do
      with PHashElementArray(htlArray)^[Inx] do begin
        if (heState = hesInUse) then
          if not Action(Self, heData, ExtraData) then begin
            Result := heData;
            Exit;
          end;
      end;
  end;
end;
{--------}
procedure THashTable.Join(HashTable : THashTable);
var
  Inx        : integer;
  InUseCount : integer;
begin
  if not Assigned(HashTable) then Exit;

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

  if (HashTable.Count > 0) then begin
    InUseCount := HashTable.Count;
    for Inx := 0 to pred(HashTable.htlTableSize) do begin
      with PHashElementArray(HashTable.htlArray)^[Inx] do begin
        if (heState = hesInUse) then begin
          {$IFDEF Windows}
          Insert(heString^, heData);
          DisposeStr(heString);
          {$ELSE}
          Insert(heString, heData);
          heString := '';
          {$ENDIF}
          heState := hesEmpty;
          dec(InUseCount);
          if (InUseCount = 0) then
            Break;
        end;
      end;
    end;
  end;
  HashTable.Free;
end;
{--------}
function THashTable.Search(const aKey : string; var aData : pointer) : boolean;
var
  Inx : integer;
begin
  if htlFindPrim(aKey, Inx) then begin
    Result := true;
    aData := PHashElementArray(htlArray)^[Inx].heData;
  end
  else begin
    Result := false;
    aData := nil;
  end;
end;
{====================================================================}


{$IFDEF ThreadsExist}
{===TThreadsafeHashTable=============================================}
constructor TThreadsafeHashTable.Create(aDataOwner : boolean);
begin
  inherited Create;
  htResLock := TezResourceLock.Create;
  htHashTable := THashTable.Create(aDataOwner);
end;
{--------}
destructor TThreadsafeHashTable.Destroy;
begin
  htHashTable.Free;
  htResLock.Free;
  inherited Destroy;
end;
{--------}
function TThreadsafeHashTable.AcquireAccess : THashTable;
begin
  htResLock.Lock;
  Result := htHashTable;
end;
{--------}
procedure TThreadsafeHashTable.ReleaseAccess;
begin
  htResLock.Unlock;
end;
{====================================================================}
{$ENDIF}


end.