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.


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@82205 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 55 insertions, 56 deletions

diff --git a/gcc/ada/namet.adb b/gcc/ada/namet.adb
index 1b1af12e77d..78c0df49895 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));