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>
* 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;
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;
----------------
......
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);
......
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