begin
if Debug_Flag_H then
-
for J in F'Range loop
F (J) := 0;
end loop;
- for I in Hash_Index_Type loop
- if Hash_Table (I) = No_Name then
+ for J in Hash_Index_Type loop
+ if Hash_Table (J) = No_Name then
F (0) := F (0) + 1;
else
Write_Str ("Hash_Table (");
- Write_Int (Int (I));
+ Write_Int (Int (J));
Write_Str (") has ");
declare
begin
C := 0;
- N := Hash_Table (I);
+ N := Hash_Table (J);
while N /= No_Name loop
N := Name_Entries.Table (N).Hash_Link;
F (Max_Chain_Length) := F (Max_Chain_Length) + 1;
end if;
- N := Hash_Table (I);
+ N := Hash_Table (J);
while N /= No_Name loop
S := Name_Entries.Table (N).Name_Chars_Index;
Write_Eol;
- for I in Int range 0 .. Max_Chain_Length loop
- if F (I) /= 0 then
+ for J in Int range 0 .. Max_Chain_Length loop
+ if F (J) /= 0 then
Write_Str ("Number of hash chains of length ");
- if I < 10 then
+ if J < 10 then
Write_Char (' ');
end if;
- Write_Int (I);
+ Write_Int (J);
- if I = Max_Chain_Length then
+ if J = Max_Chain_Length then
Write_Str (" or greater");
end if;
Write_Str (" = ");
- Write_Int (F (I));
+ Write_Int (F (J));
Write_Eol;
- if I /= 0 then
- Nsyms := Nsyms + F (I);
- Probes := Probes + F (I) * (1 + I) * 100;
+ if J /= 0 then
+ Nsyms := Nsyms + F (J);
+ Probes := Probes + F (J) * (1 + J) * 100;
end if;
end if;
end loop;
-- Get_Name_String --
---------------------
+ -- Procedure version leaving result in Name_Buffer, length in Name_Len
+
procedure Get_Name_String (Id : Name_Id) is
S : Int;
end loop;
end Get_Name_String;
+ ---------------------
+ -- Get_Name_String --
+ ---------------------
+
+ -- Function version returning a string
+
function Get_Name_String (Id : Name_Id) return String is
S : Int;
----------
function Hash return Hash_Index_Type is
- subtype Int_0_12 is Int range 0 .. 12;
- -- Used to avoid when others on case jump below
-
- Even_Name_Len : Integer;
- -- Last even numbered position (used for >12 case)
-
begin
-
- -- Special test for 12 (rather than counting on a when others for the
- -- case statement below) avoids some Ada compilers converting the case
- -- statement into successive jumps.
-
- -- The case of a name longer than 12 characters is handled by taking
- -- the first 6 odd numbered characters and the last 6 even numbered
- -- characters
-
- if Name_Len > 12 then
- Even_Name_Len := (Name_Len) / 2 * 2;
-
- 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 if;
-
-- 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 Int_0_12 (Name_Len) is
+ case Name_Len is
when 0 =>
return 0;
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;
----------------
procedure Initialize is
-
begin
Name_Chars.Init;
Name_Entries.Init;
-- Is_Internal_Name --
----------------------
+ -- Version taking an argument
+
function Is_Internal_Name (Id : Name_Id) return Boolean is
begin
Get_Name_String (Id);
return Is_Internal_Name;
end Is_Internal_Name;
+ ----------------------
+ -- Is_Internal_Name --
+ ----------------------
+
+ -- Version taking its input from Name_Buffer
+
function Is_Internal_Name return Boolean is
begin
if Name_Buffer (1) = '_'
S := Name_Entries.Table (New_Id).Name_Chars_Index;
- for I in 1 .. Name_Len loop
- if Name_Chars.Table (S + Int (I)) /= Name_Buffer (I) then
+ for J in 1 .. Name_Len loop
+ if Name_Chars.Table (S + Int (J)) /= Name_Buffer (J) then
goto No_Match;
end if;
end loop;
-- Set corresponding string entry in the Name_Chars table
- for I in 1 .. Name_Len loop
+ for J in 1 .. Name_Len loop
Name_Chars.Increment_Last;
- Name_Chars.Table (Name_Chars.Last) := Name_Buffer (I);
+ Name_Chars.Table (Name_Chars.Last) := Name_Buffer (J);
end loop;
Name_Chars.Increment_Last;
if In_Character_Range (C) then
declare
CC : constant Character := Get_Character (C);
-
begin
if CC in 'a' .. 'z' or else CC in '0' .. '9' then
Name_Buffer (Name_Len) := CC;
-
else
Name_Buffer (Name_Len) := 'U';
Set_Hex_Chars (Natural (C));