aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada/namet.adb
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@gcc.gnu.org>2004-05-24 17:19:11 +0200
committerArnaud Charlet <charlet@gcc.gnu.org>2004-05-24 17:19:11 +0200
commit0fb2ea01912a8a8859cb53caa6a7e33b9b8c9333 (patch)
tree3771082957c81623666f68cc0fc153c68f93f964 /gcc/ada/namet.adb
parentc86dd7db77896014952396f60db88ce551b5a431 (diff)
downloadgcc-0fb2ea01912a8a8859cb53caa6a7e33b9b8c9333.zip
gcc-0fb2ea01912a8a8859cb53caa6a7e33b9b8c9333.tar.gz
gcc-0fb2ea01912a8a8859cb53caa6a7e33b9b8c9333.tar.bz2
[multiple changes]
2004-05-24 Geert Bosch <bosch@gnat.com> * a-numaux-x86.adb (Reduce): Reimplement using an approximation of Pi with 192 bits of precision, sufficient to reduce a double-extended arguments X with a maximum relative error of T'Machine_Epsilon, for X in -2.0**32 .. 2.0**32. (Cos, Sin): Always reduce arguments of 1/4 Pi or larger, to prevent reduction by the processor, which only uses a 68-bit approximation of Pi. (Tan): Always reduce arguments and compute function either using the processor's fptan instruction, or by dividing sin and cos as needed. 2004-05-24 Doug Rupp <rupp@gnat.com> * adaint.c (__gnat_readdir): Cast CRTL function retun value to avoid gcc error on 32/64 bit VMS. 2004-05-24 Olivier Hainque <hainque@act-europe.fr> * init.c (__gnat_error_handler): Handle EEXIST as EACCES for SIGSEGVs, since this is what we get for stack overflows although not documented as such. Document the issues which may require adjustments to our signal handlers. 2004-05-24 Ed Schonberg <schonberg@gnat.com> * inline.adb (Add_Scope_To_Clean): Do not add cleanup actions to the enclosing dynamic scope if the instantiation is within a generic unit. 2004-05-24 Arnaud Charlet <charlet@act-europe.fr> * exp_dbug.ads: Fix typo. * Makefile.in: s-osinte-linux-ia64.ads was misnamed. Rename it to its proper name: system-linux-ia64.ads (stamp-gnatlib1): Remove extra target specific run time files when setting up the rts directory. 2004-05-24 Javier Miranda <miranda@gnat.com> * einfo.ads, einfo.adb (Limited_Views): Removed. (Limited_View): New attribute that replaces the previous one. It is now a bona fide package with the limited-view list through the first_entity and first_private attributes. * sem_ch10.adb (Install_Private_With_Clauses): Give support to limited-private-with clause. (Install_Limited_Withed_Unit): Install the private declarations of a limited-private-withed package. Update the installation of the shadow entities according to the new structure (see Build_Limited_Views) (Build_Limited_Views): Replace the previous implementation of the limited view by a package entity that references the first shadow entity plus the first shadow private entity (required for limited- private-with clause) (New_Internal_Shadow_Entity): Code cleanup. (Remove_Limited_With_Clause): Update the implementation to undo the new work carried out by Build_Limited_Views. (Build_Chain): Complete documentation. Replace Ada0Y by Ada 0Y in comments Minor reformating * sem_ch3.adb (Array_Type_Declaration): In case of anonymous access types the level of accessibility depends on the enclosing type declaration. * sem_ch8.adb (Find_Expanded_Name): Fix condition to detect shadow entities. Complete documentation of previous change. 2004-05-24 Robert Dewar <dewar@gnat.com> * namet.adb: Minor reformatting Avoid use of name I (replace by J) Minor code restructuring * sem_ch6.adb: Minor reformatting * lib-writ.adb: Do not set restriction as active if this is a Restriction_Warning case. * sem_prag.adb: Reset restriction warning flag if real pragma restriction encountered. * s-htable.adb: Minor reformatting Change rotate count to 3 in Hash (improves hash for small strings) * 5qsystem.ads: Add comments for type Address (no literals allowed). * gnat_ugn.texi: Add new section of documentation "Code Generation Control", which describes the use of -m switches. 2004-05-24 Eric Botcazou <ebotcazou@act-europe.fr> (tree_transform) <N_Identifier>: Do the dereference directly through the DECL_INITIAL for renamed variables. From-SVN: r82205
Diffstat (limited to 'gcc/ada/namet.adb')
-rw-r--r--gcc/ada/namet.adb111
1 files changed, 55 insertions, 56 deletions
diff --git a/gcc/ada/namet.adb b/gcc/ada/namet.adb
index 1b1af12..78c0df4 100644
--- a/gcc/ada/namet.adb
+++ b/gcc/ada/namet.adb
@@ -139,18 +139,17 @@ package body Namet is
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
@@ -160,7 +159,7 @@ package body Namet is
begin
C := 0;
- N := Hash_Table (I);
+ N := Hash_Table (J);
while N /= No_Name loop
N := Name_Entries.Table (N).Hash_Link;
@@ -177,7 +176,7 @@ package body Namet is
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;
@@ -196,27 +195,27 @@ package body Namet is
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;
@@ -560,6 +559,8 @@ package body Namet is
-- Get_Name_String --
---------------------
+ -- Procedure version leaving result in Name_Buffer, length in Name_Len
+
procedure Get_Name_String (Id : Name_Id) is
S : Int;
@@ -574,6 +575,12 @@ package body Namet is
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;
@@ -656,45 +663,12 @@ package body Namet is
----------
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;
@@ -813,6 +787,26 @@ package body Namet is
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;
@@ -821,7 +815,6 @@ package body Namet is
----------------
procedure Initialize is
-
begin
Name_Chars.Init;
Name_Entries.Init;
@@ -853,12 +846,20 @@ package body Namet is
-- 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) = '_'
@@ -1033,8 +1034,8 @@ package body Namet is
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;
@@ -1069,9 +1070,9 @@ package body Namet is
-- 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;
@@ -1149,11 +1150,9 @@ package body Namet is
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));