a-reatim.adb: Documentation addition

2007-04-20  Robert Dewar  <dewar@adacore.com>

	* a-reatim.adb: Documentation addition

	* g-cgideb.adb: Minor code reorganization

	* tree_io.adb, treepr.adb, cstand.adb, krunch.adb, par.adb,
	mdll-utl.adb, par-ch5.adb, par-tchk.adb, s-exctab.ads, s-memory.ads,
	s-osprim.ads, s-restri.ads, s-soflin.ads: Minor reformatting.

	* debug.ads, debug.adb (Get_Debug_Flag_K): Remove unused obsolete
	function.  Change name New_Scope to Push_Scope
	(Get_Debug_Flag_K): Remove unused obsolete function.

	* exp_ch8.adb, inline.adb, sem_ch8.ads: Change name New_Scope to
	Push_Scope.

	* makeusg.adb: Update Copyright notice
	Add line for switch -aP

	* makeusg.adb: Fix wording of some usage messages

	* s-assert.adb (Raise_Assert_Failure): Add call to
	Debug_Raise_Assert_Failure.

	* s-unstyp.ads (type Packed_Bytes2): Change alignment to use 'Min
	(2, Standard'Alignment) for compatibility with AAMP (where alignment
	is restricted to 1).

	* s-wchjis.adb: Remove use of System.Pure_Exceptions

	* tbuild.ads, tbuild.adb (Make_Implicit_Exception_Handler): Set the
	node location to No_Location when we're not debugging the expanded
	code.

From-SVN: r125478

gcc/ada/a-reatim.adb

@@ -241,6 +241,11 @@ package body Ada.Real_Time is
 
    function To_Time_Span (D : Duration) return Time_Span is
    begin
+      --  Note regarding AI-00432 requiring range checking on this conversion.
+      --  In almost all versions of GNAT (and all to which this version of the
+      --  Ada.Real_Time package apply), the range of Time_Span and Duration are
+      --  the same, so there is no issue of overflow.
+
       return Time_Span (D);
    end To_Time_Span;
 

gcc/ada/cstand.adb

@@ -430,7 +430,7 @@ package body CStand is
       --    range False .. True
 
       --  where the occurrences of the literals must point to the
-      --  corresponding  definition.
+      --  corresponding definition.
 
       R_Node := New_Node (N_Range, Stloc);
       B_Node := New_Node (N_Identifier, Stloc);

gcc/ada/debug.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2006, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -326,7 +326,7 @@ package body Debug is
    --       an interepretation is incompatible with the context.
 
    --  dw   Write semantic scope stack messages. Each time a scope is created
-   --       or removed, a message is output (see the Sem_Ch8.New_Scope and
+   --       or removed, a message is output (see the Sem_Ch8.Push_Scope and
    --       Sem_Ch8.Pop_Scope subprograms).
 
    --  dx   Force expansion on, even if no code being generated. Normally the
@@ -604,15 +604,6 @@ package body Debug is
    --  dw  Prints the list of units withed by the unit currently explored
    --      during the main loop of Make.Compile_Sources.
 
-   ----------------------
-   -- Get_Debug_Flag_K --
-   ----------------------
-
-   function Get_Debug_Flag_K return Boolean is
-   begin
-      return Debug_Flag_K;
-   end Get_Debug_Flag_K;
-
    --------------------
    -- Set_Debug_Flag --
    --------------------

gcc/ada/debug.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -179,10 +179,6 @@ package Debug is
    Debug_Flag_Dot_8 : Boolean := False;
    Debug_Flag_Dot_9 : Boolean := False;
 
-   function Get_Debug_Flag_K return Boolean;
-   --  This function is called from C code to get the setting of the K flag
-   --  (it does not work to try to access a constant object directly).
-
    procedure Set_Debug_Flag (C : Character; Val : Boolean := True);
    --  Where C is 0-9, A-Z, or a-z, sets the corresponding debug flag to
    --  the given value. In the checks off version of debug, the call to

gcc/ada/exp_ch8.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2006, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -310,7 +310,7 @@ package body Exp_Ch8 is
                Aux : constant Node_Id := Aux_Decls_Node (Parent (N));
 
             begin
-               New_Scope (Standard_Standard);
+               Push_Scope (Standard_Standard);
 
                if No (Actions (Aux)) then
                   Set_Actions (Aux, New_List (Decl));

gcc/ada/g-cgideb.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---                     Copyright (C) 2000-2006, AdaCore                     --
+--                     Copyright (C) 2000-2007, AdaCore                     --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -131,12 +131,11 @@ package body GNAT.CGI.Debug is
          Result : Unbounded_String;
 
       begin
-         Result := Result
-           & Title (Mode, "CGI complete runtime environment");
-
-         Result := Result
-           & Header (Mode, "CGI parameters:")
-           & New_Line (Mode);
+         Result :=
+           To_Unbounded_String
+             (Title (Mode, "CGI complete runtime environment")
+              & Header (Mode, "CGI parameters:")
+              & New_Line (Mode));
 
          for K in 1 .. Argument_Count loop
             Result := Result

gcc/ada/inline.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2006, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -33,6 +33,7 @@ with Exp_Tss;  use Exp_Tss;
 with Fname;    use Fname;
 with Fname.UF; use Fname.UF;
 with Lib;      use Lib;
+with Namet;    use Namet;
 with Nlists;   use Nlists;
 with Opt;      use Opt;
 with Sem_Ch8;  use Sem_Ch8;
@@ -246,12 +247,24 @@ package body Inline is
       -----------------
 
       function Must_Inline return Boolean is
-         Scop : Entity_Id := Current_Scope;
+         Scop : Entity_Id;
          Comp : Node_Id;
 
       begin
          --  Check if call is in main unit
 
+         Scop := Current_Scope;
+
+         --  Do not try to inline if scope is standard. This could happen, for
+         --  example, for a call to Add_Global_Declaration, and it causes
+         --  trouble to try to inline at this level.
+
+         if Scop = Standard_Standard then
+            return False;
+         end if;
+
+         --  Otherwise lookup scope stack to outer scope
+
          while Scope (Scop) /= Standard_Standard
            and then not Is_Child_Unit (Scop)
          loop
@@ -259,7 +272,6 @@ package body Inline is
          end loop;
 
          Comp := Parent (Scop);
-
          while Nkind (Comp) /= N_Compilation_Unit loop
             Comp := Parent (Comp);
          end loop;
@@ -271,8 +283,7 @@ package body Inline is
             return True;
          end if;
 
-         --  Call is not in main unit. See if it's in some inlined
-         --  subprogram.
+         --  Call is not in main unit. See if it's in some inlined subprogram
 
          Scop := Current_Scope;
          while Scope (Scop) /= Standard_Standard
@@ -289,7 +300,6 @@ package body Inline is
          end loop;
 
          return False;
-
       end Must_Inline;
 
    --  Start of processing for Add_Inlined_Body
@@ -563,7 +573,7 @@ package body Inline is
       Analyzing_Inlined_Bodies := False;
 
       if Serious_Errors_Detected = 0 then
-         New_Scope (Standard_Standard);
+         Push_Scope (Standard_Standard);
 
          J := 0;
          while J <= Inlined_Bodies.Last
@@ -609,7 +619,7 @@ package body Inline is
                         Error_Msg_N
                           ("one or more inlined subprograms accessed in $!",
                            Comp_Unit);
-                        Error_Msg_Name_1 :=
+                        Error_Msg_File_1 :=
                           Get_File_Name (Bname, Subunit => False);
                         Error_Msg_N ("\but file{ was not found!", Comp_Unit);
                         raise Unrecoverable_Error;
@@ -860,7 +870,7 @@ package body Inline is
             end if;
          end if;
 
-         New_Scope (Scop);
+         Push_Scope (Scop);
          Expand_Cleanup_Actions (Decl);
          End_Scope;
 
@@ -935,7 +945,7 @@ package body Inline is
       if Serious_Errors_Detected = 0 then
 
          Expander_Active := (Operating_Mode = Opt.Generate_Code);
-         New_Scope (Standard_Standard);
+         Push_Scope (Standard_Standard);
          To_Clean := New_Elmt_List;
 
          if Is_Generic_Unit (Cunit_Entity (Main_Unit)) then

gcc/ada/krunch.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2006, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -130,7 +130,7 @@ begin
      and then (B1 = 'a' or else B1 = 'g' or else B1 = 'i' or else B1 = 's')
      and then Len <= Maxlen
    then
-      --  When VMS is the host, it is always also the target.
+      --  When VMS is the host, it is always also the target
 
       if Hostparm.OpenVMS or else VMS_On_Target then
          Len := Len + 1;

gcc/ada/makeusg.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2006, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -203,17 +203,17 @@ begin
 
    --  Line for -we
 
-   Write_Str ("  -we      treat all Warnings as Errors");
+   Write_Str ("  -we      Treat all warnings as errors");
    Write_Eol;
 
    --  Line for -wn
 
-   Write_Str ("  -wn      Normal Warning mode (cancels -we/-ws)");
+   Write_Str ("  -wn      Normal warning mode (cancels -we/-ws)");
    Write_Eol;
 
    --  Line for -ws
 
-   Write_Str ("  -ws      Suppress all Warnings");
+   Write_Str ("  -ws      Suppress all warnings");
    Write_Eol;
 
    --  Line for -x
@@ -246,7 +246,12 @@ begin
 
    --  Source and Library search path switches
 
-   Write_Str ("Source and Library search path switches:");
+   Write_Str ("Project, Source and Library search path switches:");
+   Write_Eol;
+
+   --  Line for -aP
+
+   Write_Str ("  -aPdir    Add directory dir to project search path");
    Write_Eol;
 
    --  Line for -aL

gcc/ada/mdll-utl.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2006, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -100,6 +100,7 @@ package body MDLL.Utl is
       Bas_Opt    : aliased String := "--base-file";
       Bas_V      : aliased String := Base_File;
       No_Suf_Opt : aliased String := "-k";
+
    begin
       Arguments (1 .. 4) := (1 => Def_Opt'Unchecked_Access,
                              2 => Def_V'Unchecked_Access,
@@ -141,7 +142,6 @@ package body MDLL.Utl is
          Exceptions.Raise_Exception
            (Tools_Error'Identity, Dlltool_Name & " execution error.");
       end if;
-
    end Dlltool;
 
    ---------
@@ -286,7 +286,7 @@ package body MDLL.Utl is
          --  Delete binder files
          declare
             Base_Name : constant String :=
-              Directory_Operations.Base_Name (Ali, ".ali");
+                          Directory_Operations.Base_Name (Ali, ".ali");
          begin
             OS_Lib.Delete_File ("b~" & Base_Name & ".ads", Success);
             OS_Lib.Delete_File ("b~" & Base_Name & ".adb", Success);

gcc/ada/par-ch5.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -602,8 +602,8 @@ package body Ch5 is
                         Statement_Required := False;
 
                      --  A slash following an identifier or a selected
-                     --  component in this situation is most likely a
-                     --  period (have a look at the keyboard :-)
+                     --  component in this situation is most likely a period
+                     --  (see location of keys on keyboard).
 
                      elsif Token = Tok_Slash
                        and then (Nkind (Name_Node) = N_Identifier

gcc/ada/par-tchk.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2006, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -417,26 +417,25 @@ package body Tchk is
          return;
 
       --  An interesting little kludge here. If the previous token is a
-      --  semicolon, then there is no way that we can legitimately need
-      --  another semicolon. This could only arise in an error situation
-      --  where an error has already been signalled. By simply ignoring
-      --  the request for a semicolon in this case, we avoid some spurious
-      --  missing semicolon messages.
+      --  semicolon, then there is no way that we can legitimately need another
+      --  semicolon. This could only arise in an error situation where an error
+      --  has already been signalled. By simply ignoring the request for a
+      --  semicolon in this case, we avoid some spurious missing semicolon
+      --  messages.
 
       elsif Prev_Token = Tok_Semicolon then
          return;
 
-      --  If the current token is | then this is a reasonable
-      --  place to suggest the possibility of a "C" confusion :-)
+      --  If the current token is | then this is a reasonable place to suggest
+      --  the possibility of a "C" confusion.
 
       elsif Token = Tok_Vertical_Bar then
          Error_Msg_SC ("unexpected occurrence of ""'|"", did you mean OR'?");
          Resync_Past_Semicolon;
          return;
 
-      --  Deal with pragma. If pragma is not at start of line, it is
-      --  considered misplaced otherwise we treat it as a normal
-      --  missing semicolong case.
+      --  Deal with pragma. If pragma is not at start of line, it is considered
+      --  misplaced otherwise we treat it as a normal missing semicolong case.
 
       elsif Token = Tok_Pragma
         and then not Token_Is_At_Start_Of_Line

gcc/ada/par.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2006, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -184,7 +184,7 @@ is
    --   of such a nested region. Again, like case 2, this causes us to miss
    --   some nested cases, but it doesn't seen worth the effort to stack and
    --   unstack the SIS information. Maybe we will reconsider this if we ever
-   --   get a complaint about a missed case :-)
+   --   get a complaint about a missed case.
 
    --   4. We encounter a valid pragma INTERFACE or IMPORT that effectively
    --   supplies the missing body. In this case we reset the entry.

gcc/ada/s-assert.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2007, Free Software Foundation, Inc.          --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -32,6 +32,7 @@
 ------------------------------------------------------------------------------
 
 with Ada.Exceptions;
+with System.Exceptions;
 
 package body System.Assertions is
 
@@ -41,6 +42,7 @@ package body System.Assertions is
 
    procedure Raise_Assert_Failure (Msg : String) is
    begin
+      System.Exceptions.Debug_Raise_Assert_Failure;
       Ada.Exceptions.Raise_Exception (Assert_Failure'Identity, Msg);
    end Raise_Assert_Failure;
 

gcc/ada/s-exctab.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1996-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 1996-2006, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -62,7 +62,7 @@ package System.Exception_Table is
    --  does not exist yet, null is returned.
 
    function Registered_Exceptions_Count return Natural;
-   --  Return the number of currently registered exceptions.
+   --  Return the number of currently registered exceptions
 
    type Exception_Data_Array is array (Natural range <>)
      of SSL.Exception_Data_Ptr;
@@ -70,6 +70,6 @@ package System.Exception_Table is
    procedure Get_Registered_Exceptions
      (List : out Exception_Data_Array;
       Last : out Integer);
-   --  Return the list of registered exceptions.
+   --  Return the list of registered exceptions
 
 end System.Exception_Table;

gcc/ada/s-memory.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2001-2003 Free Software Foundation, Inc.          --
+--          Copyright (C) 2001-2007, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -75,8 +75,7 @@ package System.Memory is
 
    function Realloc
      (Ptr  : System.Address;
-      Size : size_t)
-      return System.Address;
+      Size : size_t) return System.Address;
    --  This is the low level reallocation routine. It takes an existing
    --  block address returned by a previous call to Alloc or Realloc,
    --  and reallocates the block. The size can either be increased or

gcc/ada/s-osprim.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  S p e c                                 --
 --                                                                          --
---          Copyright (C) 1998-2006, Free Software Foundation, Inc.         --
+--          Copyright (C) 1998-2007, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNARL is free software; you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -47,7 +47,7 @@ package System.OS_Primitives is
                                         Duration'Last);
    --  Max of half a year delay, needed to prevent exceptions for large delay
    --  values. It seems unlikely that any test will notice this restriction,
-   --  except in the case of applications setting the clock at at run time (see
+   --  except in the case of applications setting the clock at run time (see
    --  s-tastim.adb). Also note that a larger value might cause problems (e.g
    --  overflow, or more likely OS limitation in the primitives used). In the
    --  case where half a year is too long (which occurs in high integrity mode

gcc/ada/s-restri.ads

@@ -44,6 +44,7 @@ with System.Rident;
 
 package System.Restrictions is
    pragma Preelaborate;
+
    pragma Discard_Names;
    package Rident is new System.Rident;
 

gcc/ada/s-soflin.ads

@@ -52,8 +52,7 @@ package System.Soft_Links is
 
    function Current_Target_Exception return EO;
    pragma Import
-     (Ada, Current_Target_Exception,
-      "__gnat_current_target_exception");
+     (Ada, Current_Target_Exception, "__gnat_current_target_exception");
    --  Import this subprogram from the private part of Ada.Exceptions
 
    --  First we have the access subprogram types used to establish the links.

gcc/ada/s-unstyp.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2006, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -63,24 +63,24 @@ package System.Unsigned_Types is
    --  for details.
 
    type Packed_Bytes2 is new Packed_Bytes1;
-   for Packed_Bytes2'Alignment use 2;
+   for Packed_Bytes2'Alignment use Integer'Min (2, Standard'Maximum_Alignment);
    --  This is the type used to implement packed arrays where an alignment
-   --  of 2 is helpful for maximum efficiency of the get and set routines
-   --  in the corresponding library unit. This is true of all component
-   --  sizes that are even but not divisible by 4 (other than 2 for which
-   --  we use direct masking operations). In such cases, the clusters can
-   --  be assumed to be 2-byte aligned if the array is aligned. See for
+   --  of 2 (is possible) is helpful for maximum efficiency of the get and
+   --  set routines in the corresponding library unit. This is true of all
+   --  component sizes that are even but not divisible by 4 (other than 2 for
+   --  which we use direct masking operations). In such cases, the clusters
+   --  can be assumed to be 2-byte aligned if the array is aligned. See for
    --  example System.Pack_10 in file s-pack10).
 
    type Packed_Bytes4 is new Packed_Bytes1;
    for Packed_Bytes4'Alignment use Integer'Min (4, Standard'Maximum_Alignment);
    --  This is the type used to implement packed arrays where an alignment
-   --  of 4 is helpful for maximum efficiency of the get and set routines
-   --  in the corresponding library unit. This is true of all component
-   --  sizes that are divisible by 4 (other than powers of 2, which are
-   --  either handled by direct masking or not packed at all). In such cases
-   --  the clusters can be assumed to be 4-byte aligned if the array is
-   --  aligned (see System.Pack_12 in file s-pack12 as an example).
+   --  of 4 (if possible) is helpful for maximum efficiency of the get and
+   --  set routines in the corresponding library unit. This is true of all
+   --  component sizes that are divisible by 4 (other than powers of 2, which
+   --  are either handled by direct masking or not packed at all). In such
+   --  cases the clusters can be assumed to be 4-byte aligned if the array
+   --  is aligned (see System.Pack_12 in file s-pack12 as an example).
 
    type Bits_1 is mod 2**1;
    type Bits_2 is mod 2**2;
@@ -92,128 +92,103 @@ package System.Unsigned_Types is
 
    function Shift_Left
      (Value  : Short_Short_Unsigned;
-      Amount : Natural)
-      return   Short_Short_Unsigned;
+      Amount : Natural) return Short_Short_Unsigned;
 
    function Shift_Right
      (Value  : Short_Short_Unsigned;
-      Amount : Natural)
-      return   Short_Short_Unsigned;
+      Amount : Natural) return Short_Short_Unsigned;
 
    function Shift_Right_Arithmetic
      (Value  : Short_Short_Unsigned;
-      Amount : Natural)
-      return   Short_Short_Unsigned;
+      Amount : Natural) return Short_Short_Unsigned;
 
    function Rotate_Left
      (Value  : Short_Short_Unsigned;
-      Amount : Natural)
-      return   Short_Short_Unsigned;
+      Amount : Natural) return Short_Short_Unsigned;
 
    function Rotate_Right
      (Value  : Short_Short_Unsigned;
-      Amount : Natural)
-      return   Short_Short_Unsigned;
+      Amount : Natural) return Short_Short_Unsigned;
 
    function Shift_Left
      (Value  : Short_Unsigned;
-      Amount : Natural)
-      return   Short_Unsigned;
+      Amount : Natural) return Short_Unsigned;
 
    function Shift_Right
      (Value  : Short_Unsigned;
-      Amount : Natural)
-      return   Short_Unsigned;
+      Amount : Natural) return Short_Unsigned;
 
    function Shift_Right_Arithmetic
      (Value  : Short_Unsigned;
-      Amount : Natural)
-      return   Short_Unsigned;
+      Amount : Natural) return Short_Unsigned;
 
    function Rotate_Left
      (Value  : Short_Unsigned;
-      Amount : Natural)
-      return   Short_Unsigned;
+      Amount : Natural) return Short_Unsigned;
 
    function Rotate_Right
      (Value  : Short_Unsigned;
-      Amount : Natural)
-      return   Short_Unsigned;
+      Amount : Natural) return Short_Unsigned;
 
    function Shift_Left
      (Value  : Unsigned;
-      Amount : Natural)
-     return    Unsigned;
+      Amount : Natural) return Unsigned;
 
    function Shift_Right
      (Value  : Unsigned;
-      Amount : Natural)
-      return   Unsigned;
+      Amount : Natural) return Unsigned;
 
    function Shift_Right_Arithmetic
      (Value  : Unsigned;
-      Amount : Natural)
-      return   Unsigned;
+      Amount : Natural) return Unsigned;
 
    function Rotate_Left
      (Value  : Unsigned;
-      Amount : Natural)
-      return   Unsigned;
+      Amount : Natural) return Unsigned;
 
    function Rotate_Right
      (Value  : Unsigned;
-      Amount : Natural)
-      return   Unsigned;
+      Amount : Natural) return Unsigned;
 
    function Shift_Left
      (Value  : Long_Unsigned;
-      Amount : Natural)
-     return    Long_Unsigned;
+      Amount : Natural) return Long_Unsigned;
 
    function Shift_Right
      (Value  : Long_Unsigned;
-      Amount : Natural)
-      return   Long_Unsigned;
+      Amount : Natural) return Long_Unsigned;
 
    function Shift_Right_Arithmetic
      (Value  : Long_Unsigned;
-      Amount : Natural)
-      return   Long_Unsigned;
+      Amount : Natural) return Long_Unsigned;
 
    function Rotate_Left
      (Value  : Long_Unsigned;
-      Amount : Natural)
-      return   Long_Unsigned;
+      Amount : Natural) return Long_Unsigned;
 
    function Rotate_Right
      (Value  : Long_Unsigned;
-      Amount : Natural)
-      return   Long_Unsigned;
+      Amount : Natural) return Long_Unsigned;
 
    function Shift_Left
      (Value  : Long_Long_Unsigned;
-      Amount : Natural)
-     return    Long_Long_Unsigned;
+      Amount : Natural) return Long_Long_Unsigned;
 
    function Shift_Right
      (Value  : Long_Long_Unsigned;
-      Amount : Natural)
-      return   Long_Long_Unsigned;
+      Amount : Natural) return Long_Long_Unsigned;
 
    function Shift_Right_Arithmetic
      (Value  : Long_Long_Unsigned;
-      Amount : Natural)
-      return   Long_Long_Unsigned;
+      Amount : Natural) return Long_Long_Unsigned;
 
    function Rotate_Left
      (Value  : Long_Long_Unsigned;
-      Amount : Natural)
-      return   Long_Long_Unsigned;
+      Amount : Natural) return Long_Long_Unsigned;
 
    function Rotate_Right
      (Value  : Long_Long_Unsigned;
-      Amount : Natural)
-      return   Long_Long_Unsigned;
+      Amount : Natural) return Long_Long_Unsigned;
 
    pragma Import (Intrinsic, Shift_Left);
    pragma Import (Intrinsic, Shift_Right);

gcc/ada/s-wchjis.adb

@@ -31,8 +31,6 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
-with System.Pure_Exceptions; use System.Pure_Exceptions;
-
 package body System.WCh_JIS is
 
    type Byte is mod 256;
@@ -86,7 +84,7 @@ package body System.WCh_JIS is
          --  bit is set in both bytes.
 
          if JIS2 < 16#80# then
-            Raise_Exception (CE, "invalid small Katakana character");
+            raise Constraint_Error;
          end if;
 
          EUC1 := Character'Val (EUC_Hankaku_Kana);
@@ -96,7 +94,7 @@ package body System.WCh_JIS is
       --  a valid character for representation in EUC form.
 
       elsif JIS1 > 16#7F# or else JIS2 > 16#7F# then
-         Raise_Exception (CE, "wide character value out of EUC range");
+         raise Constraint_Error;
 
       --  Result is just the two characters with upper bits set
 

gcc/ada/sem_ch8.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2004 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -122,7 +122,7 @@ package Sem_Ch8 is
    --  S is the entity of a scope. This function determines if this scope
    --  is currently open (i.e. it appears somewhere in the scope stack).
 
-   procedure New_Scope (S : Entity_Id);
+   procedure Push_Scope (S : Entity_Id);
    --  Make new scope stack entry, pushing S, the entity for a scope
    --  onto the top of the scope table. The current setting of the scope
    --  suppress flags is saved for restoration on exit.

gcc/ada/tbuild.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2006, Free Software Foundation, Inc.        --
+--          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -28,9 +28,9 @@ with Atree;    use Atree;
 with Einfo;    use Einfo;
 with Elists;   use Elists;
 with Lib;      use Lib;
-with Namet;    use Namet;
 with Nlists;   use Nlists;
 with Nmake;    use Nmake;
+with Opt;      use Opt;
 with Restrict; use Restrict;
 with Rident;   use Rident;
 with Sinfo;    use Sinfo;
@@ -209,10 +209,32 @@ package body Tbuild is
       Exception_Choices : List_Id;
       Statements        : List_Id) return Node_Id
    is
-      Handler : constant Node_Id :=
-                  Make_Exception_Handler
-                    (Sloc, Choice_Parameter, Exception_Choices, Statements);
+      Handler : Node_Id;
+      Loc     : Source_Ptr;
+
    begin
+      --  Set the source location only when debugging the expanded code
+
+      --  When debugging the source code directly, we do not want the compiler
+      --  to associate this implicit exception handler with any specific source
+      --  line, because it can potentially confuse the debugger. The most
+      --  damaging situation would arise when the debugger tries to insert a
+      --  breakpoint at a certain line. If the code of the associated implicit
+      --  exception handler is generated before the code of that line, then the
+      --  debugger will end up inserting the breakpoint inside the exception
+      --  handler, rather than the code the user intended to break on. As a
+      --  result, it is likely that the program will not hit the breakpoint
+      --  as expected.
+
+      if Debug_Generated_Code then
+         Loc := Sloc;
+      else
+         Loc := No_Location;
+      end if;
+
+      Handler :=
+        Make_Exception_Handler
+          (Loc, Choice_Parameter, Exception_Choices, Statements);
       Set_Local_Raise_Statements (Handler, No_Elist);
       return Handler;
    end Make_Implicit_Exception_Handler;

gcc/ada/tbuild.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2006, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -27,6 +27,7 @@
 --  This package contains various utility procedures to assist in
 --  building specific types of tree nodes.
 
+with Namet; use Namet;
 with Types; use Types;
 
 package Tbuild is

gcc/ada/tree_io.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2002 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -448,6 +448,10 @@ package body Tree_IO is
       procedure Write_Non_Compressed_Sequence;
       --  Output currently collected sequence of non-compressible data
 
+      -----------------------------------
+      -- Write_Non_Compressed_Sequence --
+      -----------------------------------
+
       procedure Write_Non_Compressed_Sequence is
       begin
          if NC > 0 then

gcc/ada/treepr.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2006, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -1004,9 +1004,7 @@ package body Treepr is
          --  Print Etype field if present (printing of this field for entities
          --  is handled by the Print_Entity_Info procedure).
 
-         if Nkind (N) in N_Has_Etype
-           and then Present (Etype (N))
-         then
+         if Nkind (N) in N_Has_Etype and then Present (Etype (N)) then
             Print_Str (Prefix_Str_Char);
             Print_Str ("Etype = ");
             Print_Node_Ref (Etype (N));