From 329b9f810de49de85e57c8c6a1071a4063276a3a Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 26 Oct 2010 14:53:09 +0200 Subject: [PATCH] [multiple changes] 2010-10-26 Bob Duff * namet.adb: Improve hash function. Increase the size from 2**12 to 2**16 buckets. 2010-10-26 Thomas Quinot * sem_disp.adb: Minor reformatting. From-SVN: r165954 --- gcc/ada/ChangeLog | 8 +++ gcc/ada/namet.adb | 168 +++++++-------------------------------------------- gcc/ada/sem_disp.adb | 27 ++++----- 3 files changed, 43 insertions(+), 160 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 20a067c..cae1529 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,11 @@ +2010-10-26 Bob Duff + + * namet.adb: Improve hash function. + +2010-10-26 Thomas Quinot + + * sem_disp.adb: Minor reformatting. + 2010-10-26 Robert Dewar * 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 69f7afe..63b7104 100644 --- 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 d52e59f..25e4a6d 100644 --- 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); -- 2.7.4