[multiple changes]

2010-10-26  Bob Duff  <duff@adacore.com>

	* namet.adb: Improve hash function.
	Increase the size from 2**12 to 2**16 buckets.

2010-10-26  Thomas Quinot  <quinot@adacore.com>

	* sem_disp.adb: Minor reformatting.

From-SVN: r165954

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 20a067cea7aea443b206a9a4de40ee5fef0027e9..cae15291b245ccaa3554cdddb79624145d5ff183 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,11 @@
+2010-10-26  Bob Duff  <duff@adacore.com>
+
+       * namet.adb: Improve hash function.
+
+2010-10-26  Thomas Quinot  <quinot@adacore.com>
+
+       * sem_disp.adb: Minor reformatting.
+
 2010-10-26  Robert Dewar  <dewar@adacore.com>
 
        * sem_ch3.adb, sem_ch4.adb, sem_disp.adb, switch-c.adb: Minor

diff --git a/gcc/ada/namet.adb b/gcc/ada/namet.adb
index 69f7afefa0efbcc31fa871bc3dd1e810dcf8ef4d..63b7104501ec4867a5b4a33ec97182e2cc60fd3c 100644 (file)
--- a/gcc/ada/namet.adb
+++ b/gcc/ada/namet.adb
@@ -39,6 +39,8 @@ with Output;   use Output;
 with Tree_IO;  use Tree_IO;
 with Widechar; use Widechar;
 
+with Interfaces; use Interfaces;
+
 package body Namet is
 
    Name_Chars_Reserve   : constant := 5000;
@@ -50,7 +52,7 @@ package body Namet is
    --  reallocating during this second unlocked phase, we reserve a bit of
    --  extra space before doing the release call.
 
-   Hash_Num : constant Int := 2**12;
+   Hash_Num : constant Int := 2**16;
    --  Number of headers in the hash table. Current hash algorithm is closely
    --  tailored to this choice, so it can only be changed if a corresponding
    --  change is made to the hash algorithm.
@@ -743,151 +745,27 @@ package body Namet is
    ----------
 
    function Hash return Hash_Index_Type is
+
+      --  This hash function looks at every character, in order to make it
+      --  likely that similar strings get different hash values. The rotate by
+      --  7 bits has been determined empirically to be good, and it doesn't
+      --  lose bits like a shift would. The final conversion can't overflow,
+      --  because the table is 2**16 in size. This function probably needs to
+      --  be changed if the hash table size is changed.
+
+      --  Note that we could get some speed improvement by aligning the string
+      --  to 32 or 64 bits, and doing word-wise xor's. We could also implement
+      --  a growable table. It doesn't seem worth the trouble to do those
+      --  things, for now.
+
+      Result : Unsigned_16 := 0;
+
    begin
-      --  For the cases of 1-12 characters, all characters participate in the
-      --  hash. The positioning is randomized, with the bias that characters
-      --  later on participate fully (i.e. are added towards the right side).
-
-      case Name_Len is
-
-         when 0 =>
-            return 0;
-
-         when 1 =>
-            return
-               Character'Pos (Name_Buffer (1));
-
-         when 2 =>
-            return ((
-              Character'Pos (Name_Buffer (1))) * 64 +
-              Character'Pos (Name_Buffer (2))) mod Hash_Num;
-
-         when 3 =>
-            return (((
-              Character'Pos (Name_Buffer (1))) * 16 +
-              Character'Pos (Name_Buffer (3))) * 16 +
-              Character'Pos (Name_Buffer (2))) mod Hash_Num;
-
-         when 4 =>
-            return ((((
-              Character'Pos (Name_Buffer (1))) * 8 +
-              Character'Pos (Name_Buffer (2))) * 8 +
-              Character'Pos (Name_Buffer (3))) * 8 +
-              Character'Pos (Name_Buffer (4))) mod Hash_Num;
-
-         when 5 =>
-            return (((((
-              Character'Pos (Name_Buffer (4))) * 8 +
-              Character'Pos (Name_Buffer (1))) * 4 +
-              Character'Pos (Name_Buffer (3))) * 4 +
-              Character'Pos (Name_Buffer (5))) * 8 +
-              Character'Pos (Name_Buffer (2))) mod Hash_Num;
-
-         when 6 =>
-            return ((((((
-              Character'Pos (Name_Buffer (5))) * 4 +
-              Character'Pos (Name_Buffer (1))) * 4 +
-              Character'Pos (Name_Buffer (4))) * 4 +
-              Character'Pos (Name_Buffer (2))) * 4 +
-              Character'Pos (Name_Buffer (6))) * 4 +
-              Character'Pos (Name_Buffer (3))) mod Hash_Num;
-
-         when 7 =>
-            return (((((((
-              Character'Pos (Name_Buffer (4))) * 4 +
-              Character'Pos (Name_Buffer (3))) * 4 +
-              Character'Pos (Name_Buffer (1))) * 4 +
-              Character'Pos (Name_Buffer (2))) * 2 +
-              Character'Pos (Name_Buffer (5))) * 2 +
-              Character'Pos (Name_Buffer (7))) * 2 +
-              Character'Pos (Name_Buffer (6))) mod Hash_Num;
-
-         when 8 =>
-            return ((((((((
-              Character'Pos (Name_Buffer (2))) * 4 +
-              Character'Pos (Name_Buffer (1))) * 4 +
-              Character'Pos (Name_Buffer (3))) * 2 +
-              Character'Pos (Name_Buffer (5))) * 2 +
-              Character'Pos (Name_Buffer (7))) * 2 +
-              Character'Pos (Name_Buffer (6))) * 2 +
-              Character'Pos (Name_Buffer (4))) * 2 +
-              Character'Pos (Name_Buffer (8))) mod Hash_Num;
-
-         when 9 =>
-            return (((((((((
-              Character'Pos (Name_Buffer (2))) * 4 +
-              Character'Pos (Name_Buffer (1))) * 4 +
-              Character'Pos (Name_Buffer (3))) * 4 +
-              Character'Pos (Name_Buffer (4))) * 2 +
-              Character'Pos (Name_Buffer (8))) * 2 +
-              Character'Pos (Name_Buffer (7))) * 2 +
-              Character'Pos (Name_Buffer (5))) * 2 +
-              Character'Pos (Name_Buffer (6))) * 2 +
-              Character'Pos (Name_Buffer (9))) mod Hash_Num;
-
-         when 10 =>
-            return ((((((((((
-              Character'Pos (Name_Buffer (01))) * 2 +
-              Character'Pos (Name_Buffer (02))) * 2 +
-              Character'Pos (Name_Buffer (08))) * 2 +
-              Character'Pos (Name_Buffer (03))) * 2 +
-              Character'Pos (Name_Buffer (04))) * 2 +
-              Character'Pos (Name_Buffer (09))) * 2 +
-              Character'Pos (Name_Buffer (06))) * 2 +
-              Character'Pos (Name_Buffer (05))) * 2 +
-              Character'Pos (Name_Buffer (07))) * 2 +
-              Character'Pos (Name_Buffer (10))) mod Hash_Num;
-
-         when 11 =>
-            return (((((((((((
-              Character'Pos (Name_Buffer (05))) * 2 +
-              Character'Pos (Name_Buffer (01))) * 2 +
-              Character'Pos (Name_Buffer (06))) * 2 +
-              Character'Pos (Name_Buffer (09))) * 2 +
-              Character'Pos (Name_Buffer (07))) * 2 +
-              Character'Pos (Name_Buffer (03))) * 2 +
-              Character'Pos (Name_Buffer (08))) * 2 +
-              Character'Pos (Name_Buffer (02))) * 2 +
-              Character'Pos (Name_Buffer (10))) * 2 +
-              Character'Pos (Name_Buffer (04))) * 2 +
-              Character'Pos (Name_Buffer (11))) mod Hash_Num;
-
-         when 12 =>
-            return ((((((((((((
-              Character'Pos (Name_Buffer (03))) * 2 +
-              Character'Pos (Name_Buffer (02))) * 2 +
-              Character'Pos (Name_Buffer (05))) * 2 +
-              Character'Pos (Name_Buffer (01))) * 2 +
-              Character'Pos (Name_Buffer (06))) * 2 +
-              Character'Pos (Name_Buffer (04))) * 2 +
-              Character'Pos (Name_Buffer (08))) * 2 +
-              Character'Pos (Name_Buffer (11))) * 2 +
-              Character'Pos (Name_Buffer (07))) * 2 +
-              Character'Pos (Name_Buffer (09))) * 2 +
-              Character'Pos (Name_Buffer (10))) * 2 +
-              Character'Pos (Name_Buffer (12))) mod Hash_Num;
-
-         --  Names longer than 12 characters are handled by taking the first
-         --  6 odd numbered characters and the last 6 even numbered characters.
-
-         when others => declare
-               Even_Name_Len : constant Integer := (Name_Len) / 2 * 2;
-         begin
-            return ((((((((((((
-              Character'Pos (Name_Buffer (01))) * 2 +
-              Character'Pos (Name_Buffer (Even_Name_Len - 10))) * 2 +
-              Character'Pos (Name_Buffer (03))) * 2 +
-              Character'Pos (Name_Buffer (Even_Name_Len - 08))) * 2 +
-              Character'Pos (Name_Buffer (05))) * 2 +
-              Character'Pos (Name_Buffer (Even_Name_Len - 06))) * 2 +
-              Character'Pos (Name_Buffer (07))) * 2 +
-              Character'Pos (Name_Buffer (Even_Name_Len - 04))) * 2 +
-              Character'Pos (Name_Buffer (09))) * 2 +
-              Character'Pos (Name_Buffer (Even_Name_Len - 02))) * 2 +
-              Character'Pos (Name_Buffer (11))) * 2 +
-              Character'Pos (Name_Buffer (Even_Name_Len))) mod Hash_Num;
-         end;
-      end case;
+      for J in 1 .. Name_Len loop
+         Result := Rotate_Left (Result, 7) xor Character'Pos (Name_Buffer (J));
+      end loop;
+
+      return Hash_Index_Type (Result);
    end Hash;
 
    ----------------

diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb
index d52e59f19ef487360d72879d77850e4d2242692d..25e4a6d3164d309b79f06e5cbfe0fb136afae847 100644 (file)
--- a/gcc/ada/sem_disp.adb
+++ b/gcc/ada/sem_disp.adb
@@ -1686,7 +1686,7 @@ package body Sem_Disp is
 
    begin
       --  This Ada 2012 rule is valid only for type extensions or private
-      --  extensions
+      --  extensions.
 
       if No (Tag_Typ)
         or else not Is_Record_Type (Tag_Typ)
@@ -1704,7 +1704,7 @@ package body Sem_Disp is
          Prim := Node (Elmt);
 
          --  Find an inherited hidden dispatching primitive with the name of S
-         --  and a type-conformant profile
+         --  and a type-conformant profile.
 
          if Present (Alias (Prim))
            and then Is_Hidden (Alias (Prim))
@@ -1719,7 +1719,7 @@ package body Sem_Disp is
             begin
                --  The original corresponding operation of Prim must be an
                --  operation of a visible ancestor of the dispatching type
-               --  of S, and the original corresponding operation of S2 must
+               --  S, and the original corresponding operation of S2 must
                --  be visible.
 
                Orig_Prim := Original_Corresponding_Operation (Prim);
@@ -1728,7 +1728,6 @@ package body Sem_Disp is
                  and then Is_Immediately_Visible (Orig_Prim)
                then
                   Vis_Ancestor := First_Elmt (Vis_List);
-
                   while Present (Vis_Ancestor) loop
                      Elmt :=
                        First_Elmt (Primitive_Operations (Node (Vis_Ancestor)));
@@ -1736,7 +1735,6 @@ package body Sem_Disp is
                         if Node (Elmt) = Orig_Prim then
                            Set_Overridden_Operation (S, Prim);
                            Set_Alias (Prim, Orig_Prim);
-
                            return Prim;
                         end if;
 
@@ -1769,9 +1767,9 @@ package body Sem_Disp is
    begin
       pragma Assert (Is_Interface (Find_Dispatching_Type (Iface_Prim))
         or else (Present (Alias (Iface_Prim))
-                   and then
-                     Is_Interface
-                       (Find_Dispatching_Type (Ultimate_Alias (Iface_Prim)))));
+                  and then
+                    Is_Interface
+                      (Find_Dispatching_Type (Ultimate_Alias (Iface_Prim)))));
 
       --  Search in the homonym chain. Done to speed up locating visible
       --  entities and required to catch primitives associated with the partial
@@ -1825,7 +1823,7 @@ package body Sem_Disp is
             end if;
 
          --  Use the internal entity that links the interface primitive with
-         --  the covering primitive to locate the entity
+         --  the covering primitive to locate the entity.
 
          elsif Interface_Alias (E) = Iface_Prim then
             return Alias (E);
@@ -2155,11 +2153,11 @@ package body Sem_Disp is
 
          --  Make the overriding operation into an alias of the implicit one.
          --  In this fashion a call from outside ends up calling the new body
-         --  even if non-dispatching, and a call from inside calls the
-         --  overriding operation because it hides the implicit one. To
-         --  indicate that the body of Prev_Op is never called, set its
-         --  dispatch table entity to Empty. If the overridden operation
-         --  has a dispatching result, so does the overriding one.
+         --  even if non-dispatching, and a call from inside calls the over-
+         --  riding operation because it hides the implicit one. To indicate
+         --  that the body of Prev_Op is never called, set its dispatch table
+         --  entity to Empty. If the overridden operation has a dispatching
+         --  result, so does the overriding one.
 
          Set_Alias (Prev_Op, New_Op);
          Set_DTC_Entity (Prev_Op, Empty);
@@ -2214,7 +2212,6 @@ package body Sem_Disp is
       end if;
 
       Arg := First_Actual (Call_Node);
-
       while Present (Arg) loop
          if Is_Tag_Indeterminate (Arg) then
             Propagate_Tag (Control,  Arg);