Skip to content

R
riscv-gcc-1
Commit 329b9f81 by Arnaud Charlet
Options

[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
parent 878f708a
Showing with 43 additions and 160 deletions
gcc/ada/ChangeLog
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> 2010-10-26 Robert Dewar <dewar@adacore.com>
* sem_ch3.adb, sem_ch4.adb, sem_disp.adb, switch-c.adb: Minor * sem_ch3.adb, sem_ch4.adb, sem_disp.adb, switch-c.adb: Minor
......
gcc/ada/namet.adb
...@@ -39,6 +39,8 @@ with Output; use Output; ...@@ -39,6 +39,8 @@ with Output; use Output;
with Tree_IO; use Tree_IO; with Tree_IO; use Tree_IO;
with Widechar; use Widechar; with Widechar; use Widechar;
with Interfaces; use Interfaces;
package body Namet is package body Namet is
Name_Chars_Reserve : constant := 5000; Name_Chars_Reserve : constant := 5000;
...@@ -50,7 +52,7 @@ package body Namet is ...@@ -50,7 +52,7 @@ package body Namet is
-- reallocating during this second unlocked phase, we reserve a bit of -- reallocating during this second unlocked phase, we reserve a bit of
-- extra space before doing the release call. -- 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 -- 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 -- tailored to this choice, so it can only be changed if a corresponding
-- change is made to the hash algorithm. -- change is made to the hash algorithm.
...@@ -743,151 +745,27 @@ package body Namet is ...@@ -743,151 +745,27 @@ package body Namet is
---------- ----------
function Hash return Hash_Index_Type 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 begin
-- For the cases of 1-12 characters, all characters participate in the for J in 1 .. Name_Len loop
-- hash. The positioning is randomized, with the bias that characters Result := Rotate_Left (Result, 7) xor Character'Pos (Name_Buffer (J));
-- later on participate fully (i.e. are added towards the right side). end loop;
case Name_Len is return Hash_Index_Type (Result);
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;
end Hash; end Hash;
---------------- ----------------
......
gcc/ada/sem_disp.adb
...@@ -1686,7 +1686,7 @@ package body Sem_Disp is ...@@ -1686,7 +1686,7 @@ package body Sem_Disp is
begin begin
-- This Ada 2012 rule is valid only for type extensions or private -- This Ada 2012 rule is valid only for type extensions or private
-- extensions -- extensions.
if No (Tag_Typ) if No (Tag_Typ)
or else not Is_Record_Type (Tag_Typ) or else not Is_Record_Type (Tag_Typ)
...@@ -1704,7 +1704,7 @@ package body Sem_Disp is ...@@ -1704,7 +1704,7 @@ package body Sem_Disp is
Prim := Node (Elmt); Prim := Node (Elmt);
-- Find an inherited hidden dispatching primitive with the name of S -- 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)) if Present (Alias (Prim))
and then Is_Hidden (Alias (Prim)) and then Is_Hidden (Alias (Prim))
...@@ -1719,7 +1719,7 @@ package body Sem_Disp is ...@@ -1719,7 +1719,7 @@ package body Sem_Disp is
begin begin
-- The original corresponding operation of Prim must be an -- The original corresponding operation of Prim must be an
-- operation of a visible ancestor of the dispatching type -- 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. -- be visible.
Orig_Prim := Original_Corresponding_Operation (Prim); Orig_Prim := Original_Corresponding_Operation (Prim);
...@@ -1728,7 +1728,6 @@ package body Sem_Disp is ...@@ -1728,7 +1728,6 @@ package body Sem_Disp is
and then Is_Immediately_Visible (Orig_Prim) and then Is_Immediately_Visible (Orig_Prim)
then then
Vis_Ancestor := First_Elmt (Vis_List); Vis_Ancestor := First_Elmt (Vis_List);
while Present (Vis_Ancestor) loop while Present (Vis_Ancestor) loop
Elmt := Elmt :=
First_Elmt (Primitive_Operations (Node (Vis_Ancestor))); First_Elmt (Primitive_Operations (Node (Vis_Ancestor)));
...@@ -1736,7 +1735,6 @@ package body Sem_Disp is ...@@ -1736,7 +1735,6 @@ package body Sem_Disp is
if Node (Elmt) = Orig_Prim then if Node (Elmt) = Orig_Prim then
Set_Overridden_Operation (S, Prim); Set_Overridden_Operation (S, Prim);
Set_Alias (Prim, Orig_Prim); Set_Alias (Prim, Orig_Prim);
return Prim; return Prim;
end if; end if;
...@@ -1769,9 +1767,9 @@ package body Sem_Disp is ...@@ -1769,9 +1767,9 @@ package body Sem_Disp is
begin begin
pragma Assert (Is_Interface (Find_Dispatching_Type (Iface_Prim)) pragma Assert (Is_Interface (Find_Dispatching_Type (Iface_Prim))
or else (Present (Alias (Iface_Prim)) or else (Present (Alias (Iface_Prim))
and then and then
Is_Interface Is_Interface
(Find_Dispatching_Type (Ultimate_Alias (Iface_Prim))))); (Find_Dispatching_Type (Ultimate_Alias (Iface_Prim)))));
-- Search in the homonym chain. Done to speed up locating visible -- Search in the homonym chain. Done to speed up locating visible
-- entities and required to catch primitives associated with the partial -- entities and required to catch primitives associated with the partial
...@@ -1825,7 +1823,7 @@ package body Sem_Disp is ...@@ -1825,7 +1823,7 @@ package body Sem_Disp is
end if; end if;
-- Use the internal entity that links the interface primitive with -- 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 elsif Interface_Alias (E) = Iface_Prim then
return Alias (E); return Alias (E);
...@@ -2155,11 +2153,11 @@ package body Sem_Disp is ...@@ -2155,11 +2153,11 @@ package body Sem_Disp is
-- Make the overriding operation into an alias of the implicit one. -- Make the overriding operation into an alias of the implicit one.
-- In this fashion a call from outside ends up calling the new body -- In this fashion a call from outside ends up calling the new body
-- even if non-dispatching, and a call from inside calls the -- even if non-dispatching, and a call from inside calls the over-
-- overriding operation because it hides the implicit one. To -- riding operation because it hides the implicit one. To indicate
-- indicate that the body of Prev_Op is never called, set its -- that the body of Prev_Op is never called, set its dispatch table
-- dispatch table entity to Empty. If the overridden operation -- entity to Empty. If the overridden operation has a dispatching
-- has a dispatching result, so does the overriding one. -- result, so does the overriding one.
Set_Alias (Prev_Op, New_Op); Set_Alias (Prev_Op, New_Op);
Set_DTC_Entity (Prev_Op, Empty); Set_DTC_Entity (Prev_Op, Empty);
...@@ -2214,7 +2212,6 @@ package body Sem_Disp is ...@@ -2214,7 +2212,6 @@ package body Sem_Disp is
end if; end if;
Arg := First_Actual (Call_Node); Arg := First_Actual (Call_Node);
while Present (Arg) loop while Present (Arg) loop
if Is_Tag_Indeterminate (Arg) then if Is_Tag_Indeterminate (Arg) then
Propagate_Tag (Control, Arg); Propagate_Tag (Control, Arg);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment