[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
This commit is contained in:
Arnaud Charlet
parent
878f708aba
commit
329b9f810d
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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).
|
||||
for J in 1 .. Name_Len loop
|
||||
Result := Rotate_Left (Result, 7) xor Character'Pos (Name_Buffer (J));
|
||||
end loop;
|
||||
|
||||
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;
|
||||
return Hash_Index_Type (Result);
|
||||
end Hash;
|
||||
|
||||
----------------
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
Loading…
Reference in New Issue