File : adagio-qrp.adb


------------------------------------------------------------------------------

--                         ADAGIO - ADALID - AENEA.                         --

--                                                                          --

--                            Copyright (C) 2003                            --

--                                 A. Mosteo.                               --

--                                                                          --

--  Authors: A. Mosteo. (adagio@mosteo.com)                                 --

--                                                                          --

--  If you have any questions in regard to this software, please address    --

--  them to the above email.                                                --

--                                                                          --

--  This program is free software; you can redistribute it and/or modify    --

--  it under the terms of the GNU General Public License as published by    --

--  the Free Software Foundation; either version 2 of the License, or (at   --

--  your option) any later version.                                         --

--                                                                          --

--  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.  See the GNU       --

--  General Public License for more details.                                --

--                                                                          --

--  You should have received a copy of the GNU General Public License       --

--  along with this library; if not, write to the Free Software Foundation, --

--  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.          --

--                                                                          --

--  You are not allowed to use any part of this code to develop a program   --

--  whose output would be used to harass or prosecute other users of the    --

--  networks Adagio connects with. All data collected with Adagio or a tool --

--  containing Adagio code about other network users must remain            --

--  confidential and cannot be made public by any mean, nor be used to      --

--  harass or legally prosecute these users.                                --

------------------------------------------------------------------------------

--  $Id: adagio-qrp.adb,v 1.3 2004/01/21 21:05:28 Jano Exp $


-- QRP tables are bitmaps. An 1 element is a missing element.

-- QRP tables are 0-based and have a size which is the width

--    of the hashing function.

-- For example, a 20 bits table has a bitmap of 0 .. 2 ** 20 - 1 bits.


with Adagio.Misc;
with Bit_arrays.Strings;

with Interfaces;
with Text_io; use Text_io;

package body Adagio.QRP is

   -- Necessary because bit ordering in packed array is contrary to 

   -- that used in QRTs

   function Transform (Pos : in Natural) return Natural is
      use Interfaces;
      X     : Unsigned_32 := Unsigned_32 (Pos);
   begin
      return Natural ((X and 16#fffffff8#) or (2#111# - X and 2#111#));
   end Transform;
   pragma Inline (Transform);

   ------------------------------------------------------------------------

   -- Clear                                                              --

   ------------------------------------------------------------------------

   procedure Clear (this : out Table) is
   begin
      this.Bitmap       := (others => not Marked);
      this.Used_entries := 0;
   end Clear;

   ------------------------------------------------------------------------

   -- Set                                                                --

   ------------------------------------------------------------------------

   procedure Set (this : in out Table; Pos : in Natural) is
   begin
      if this.Bitmap (Transform (Pos)) /= Marked then
         this.Used_entries := this.Used_entries + 1;
      end if;
      this.Bitmap (Transform (Pos)) := Marked;
   end Set;

   ------------------------------------------------------------------------

   -- Reset                                                              --

   ------------------------------------------------------------------------

   procedure Reset (this : in out Table; Pos : in Natural) is
   begin
      if this.Bitmap (Transform (Pos)) = Marked then
         this.Used_entries := this.Used_entries - 1;
      end if;
      this.Bitmap (Transform (Pos)) := not Marked;
   end Reset;

   ------------------------------------------------------------------------

   -- Contains                                                           --

   ------------------------------------------------------------------------

   -- Check for containment:

   function Contains (this : in Table; Pos : in Natural) return Boolean is
   begin
      return this.Bitmap (Transform (Pos));
   end Contains;

   ------------------------------------------------------------------------

   -- To_string                                                          --

   ------------------------------------------------------------------------

   -- Returns the table in a convenient format to be transferred:

   -- Returns a string of 2 ** N / 8 characters.

   function To_string (this : in Table) return String is
   begin
      return Bit_arrays.Strings.To_string (this.Bitmap);
   end To_string;

   ------------------------------------------------------------------------

   -- Ratio                                                              --

   ------------------------------------------------------------------------

   -- Return the fullness of the table (0.0 .. 1.0)

   function Ratio (this : in Table) return Ratios is
   begin
      return Float (this.Used_entries) / Float (this.Last_entry + 1);
   end Ratio;

   ------------------------------------------------------------------------

   -- Is_dirty                                                           --

   ------------------------------------------------------------------------

   -- Says if table is dirty from last cleaning:

   function Is_dirty (this : in Table) return Boolean is
   begin
      return this.Used_entries /= this.Prev_used;
   end Is_dirty;

   ------------------------------------------------------------------------

   -- Mark_undirty                                                       --

   ------------------------------------------------------------------------

   -- Mark table as clean:

   procedure Mark_undirty (this : in out Table) is
   begin
      this.Prev_used := this.Used_entries;
   end Mark_undirty;

   ------------------------------------------------------------------------

   -- Hash_number                                                        --

   ------------------------------------------------------------------------

   function Hash_number (Number, nBits : in Integer) return Integer is
      use Interfaces;
      nNumber  : Unsigned_64 := Unsigned_64 (Number);
      nProduct : Unsigned_64 := nNumber * 16#4F1BBCDC#;
      nHash    : Unsigned_64 := 
         Shift_right (Shift_left (nProduct, 32), 32 + (32 - nBits));
   begin
      return Integer (nHash);
   end Hash_number;

   ------------------------------------------------------------------------

   -- Hash_word                                                          --

   ------------------------------------------------------------------------

   function Hash_word (Word : in String; nBits : Integer) 
      return Integer is
      use Interfaces;
      type Byte_range is mod 4;
      uXor  : Unsigned_32 := 0;
      uByte : Byte_range  := 0;
      b     : Unsigned_32;
   begin
      for N in Word'Range loop
         b     := Unsigned_32 (Character'Pos (Word (N))) and 16#ff#;
         b     := Shift_left (b, Integer (uByte) * 8);
         uXor  := uXor xor b;
         uByte := uByte + 1;
      end loop;

      return Hash_number (Integer (uXor), nBits);
   end Hash_word;

   ------------------------------------------------------------------------

   -- Add_keyword                                                        --

   ------------------------------------------------------------------------

   -- Hash and add a keyword:

   procedure Add_keyword (this : in out Table; Word : in String) is
   begin
      Set (this, Hash_word (Misc.To_lower (Word), this.Bits));
   end Add_keyword;

   Test_case : UString_array := (
      U (""), U("n"), U("nd"), U("ndflaleme"));

begin
   -- Test the hash functions

--   for N in test_case'Range loop

--      Put_line (S (Test_case (N)) & ": " & 

--      Hash_word(S (Test_case (N)), 16)'img);

--   end loop;

   null;
end Adagio.QRP;