summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--gcc/ada/a-reatim.adb5
-rw-r--r--gcc/ada/cstand.adb2
-rw-r--r--gcc/ada/debug.adb13
-rw-r--r--gcc/ada/debug.ads6
-rw-r--r--gcc/ada/exp_ch8.adb4
-rw-r--r--gcc/ada/g-cgideb.adb13
-rw-r--r--gcc/ada/inline.adb30
-rw-r--r--gcc/ada/krunch.adb4
-rw-r--r--gcc/ada/makeusg.adb15
-rw-r--r--gcc/ada/mdll-utl.adb6
-rw-r--r--gcc/ada/par-ch5.adb6
-rw-r--r--gcc/ada/par-tchk.adb21
-rw-r--r--gcc/ada/par.adb4
-rw-r--r--gcc/ada/s-assert.adb4
-rw-r--r--gcc/ada/s-exctab.ads6
-rw-r--r--gcc/ada/s-memory.ads5
-rw-r--r--gcc/ada/s-osprim.ads4
-rw-r--r--gcc/ada/s-restri.ads1
-rw-r--r--gcc/ada/s-soflin.ads3
-rw-r--r--gcc/ada/s-unstyp.ads101
-rw-r--r--gcc/ada/s-wchjis.adb6
-rw-r--r--gcc/ada/sem_ch8.ads4
-rw-r--r--gcc/ada/tbuild.adb32
-rw-r--r--gcc/ada/tbuild.ads3
-rw-r--r--gcc/ada/tree_io.adb6
-rw-r--r--gcc/ada/treepr.adb6
26 files changed, 157 insertions, 153 deletions
diff --git a/gcc/ada/a-reatim.adb b/gcc/ada/a-reatim.adb
index 1049c10dd15..2ca4472a5ea 100644
--- a/gcc/ada/a-reatim.adb
+++ b/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;
diff --git a/gcc/ada/cstand.adb b/gcc/ada/cstand.adb
index fecaa2a34ab..565c36870e6 100644
--- a/gcc/ada/cstand.adb
+++ b/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);
diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb
index e0823fa70c5..1ddd1f6ded8 100644
--- a/gcc/ada/debug.adb
+++ b/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 --
--------------------
diff --git a/gcc/ada/debug.ads b/gcc/ada/debug.ads
index 2a1ae50ce97..4c7bd51876a 100644
--- a/gcc/ada/debug.ads
+++ b/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
diff --git a/gcc/ada/exp_ch8.adb b/gcc/ada/exp_ch8.adb
index 03408a77c07..6a00a3b73b5 100644
--- a/gcc/ada/exp_ch8.adb
+++ b/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));
diff --git a/gcc/ada/g-cgideb.adb b/gcc/ada/g-cgideb.adb
index 6b8020fb4ca..c3a0945c67c 100644
--- a/gcc/ada/g-cgideb.adb
+++ b/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
diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb
index f39bbbaf344..c9b43ba187c 100644
--- a/gcc/ada/inline.adb
+++ b/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
diff --git a/gcc/ada/krunch.adb b/gcc/ada/krunch.adb
index f15a7a6bdda..bb6326e06f8 100644
--- a/gcc/ada/krunch.adb
+++ b/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;
diff --git a/gcc/ada/makeusg.adb b/gcc/ada/makeusg.adb
index 027a4cfa473..a61bf07895f 100644
--- a/gcc/ada/makeusg.adb
+++ b/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
diff --git a/gcc/ada/mdll-utl.adb b/gcc/ada/mdll-utl.adb
index 7939199d206..294bbc101a3 100644
--- a/gcc/ada/mdll-utl.adb
+++ b/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);
diff --git a/gcc/ada/par-ch5.adb b/gcc/ada/par-ch5.adb
index 17c546de144..bab2637150e 100644
--- a/gcc/ada/par-ch5.adb
+++ b/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
diff --git a/gcc/ada/par-tchk.adb b/gcc/ada/par-tchk.adb
index 01ade90ee81..a87d6a09f9a 100644
--- a/gcc/ada/par-tchk.adb
+++ b/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
diff --git a/gcc/ada/par.adb b/gcc/ada/par.adb
index bebc66970fd..f33d8addd25 100644
--- a/gcc/ada/par.adb
+++ b/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.
diff --git a/gcc/ada/s-assert.adb b/gcc/ada/s-assert.adb
index 17a0a7ef967..8123e6ca181 100644
--- a/gcc/ada/s-assert.adb
+++ b/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;
diff --git a/gcc/ada/s-exctab.ads b/gcc/ada/s-exctab.ads
index a1bcde8c5a8..db0f392f19e 100644
--- a/gcc/ada/s-exctab.ads
+++ b/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;
diff --git a/gcc/ada/s-memory.ads b/gcc/ada/s-memory.ads
index 8cbca408bbf..87b28ace46c 100644
--- a/gcc/ada/s-memory.ads
+++ b/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
diff --git a/gcc/ada/s-osprim.ads b/gcc/ada/s-osprim.ads
index 917f109ad3b..6259c8a12d0 100644
--- a/gcc/ada/s-osprim.ads
+++ b/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
diff --git a/gcc/ada/s-restri.ads b/gcc/ada/s-restri.ads
index d56a19f5364..f1909e3cc5c 100644
--- a/gcc/ada/s-restri.ads
+++ b/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;
diff --git a/gcc/ada/s-soflin.ads b/gcc/ada/s-soflin.ads
index 6da5c586a9c..bc78052904e 100644
--- a/gcc/ada/s-soflin.ads
+++ b/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.
diff --git a/gcc/ada/s-unstyp.ads b/gcc/ada/s-unstyp.ads
index 2b813ef4d42..8207469a4d7 100644
--- a/gcc/ada/s-unstyp.ads
+++ b/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);
diff --git a/gcc/ada/s-wchjis.adb b/gcc/ada/s-wchjis.adb
index 079712f97b7..e18d22da3d0 100644
--- a/gcc/ada/s-wchjis.adb
+++ b/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
diff --git a/gcc/ada/sem_ch8.ads b/gcc/ada/sem_ch8.ads
index 1439a8886b0..6e3f834438b 100644
--- a/gcc/ada/sem_ch8.ads
+++ b/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.
diff --git a/gcc/ada/tbuild.adb b/gcc/ada/tbuild.adb
index 543379079d1..040fa9e5611 100644
--- a/gcc/ada/tbuild.adb
+++ b/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;
diff --git a/gcc/ada/tbuild.ads b/gcc/ada/tbuild.ads
index 67fe5a1d153..171e5a00815 100644
--- a/gcc/ada/tbuild.ads
+++ b/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
diff --git a/gcc/ada/tree_io.adb b/gcc/ada/tree_io.adb
index 95c48d45059..b62fb8e2bb2 100644
--- a/gcc/ada/tree_io.adb
+++ b/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
diff --git a/gcc/ada/treepr.adb b/gcc/ada/treepr.adb
index 4c26fd6ca81..7b1268d8c60 100644
--- a/gcc/ada/treepr.adb
+++ b/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));