diff options
| -rw-r--r-- | gcc/ada/a-reatim.adb | 5 | ||||
| -rw-r--r-- | gcc/ada/cstand.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/debug.adb | 13 | ||||
| -rw-r--r-- | gcc/ada/debug.ads | 6 | ||||
| -rw-r--r-- | gcc/ada/exp_ch8.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/g-cgideb.adb | 13 | ||||
| -rw-r--r-- | gcc/ada/inline.adb | 30 | ||||
| -rw-r--r-- | gcc/ada/krunch.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/makeusg.adb | 15 | ||||
| -rw-r--r-- | gcc/ada/mdll-utl.adb | 6 | ||||
| -rw-r--r-- | gcc/ada/par-ch5.adb | 6 | ||||
| -rw-r--r-- | gcc/ada/par-tchk.adb | 21 | ||||
| -rw-r--r-- | gcc/ada/par.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/s-assert.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/s-exctab.ads | 6 | ||||
| -rw-r--r-- | gcc/ada/s-memory.ads | 5 | ||||
| -rw-r--r-- | gcc/ada/s-osprim.ads | 4 | ||||
| -rw-r--r-- | gcc/ada/s-restri.ads | 1 | ||||
| -rw-r--r-- | gcc/ada/s-soflin.ads | 3 | ||||
| -rw-r--r-- | gcc/ada/s-unstyp.ads | 101 | ||||
| -rw-r--r-- | gcc/ada/s-wchjis.adb | 6 | ||||
| -rw-r--r-- | gcc/ada/sem_ch8.ads | 4 | ||||
| -rw-r--r-- | gcc/ada/tbuild.adb | 32 | ||||
| -rw-r--r-- | gcc/ada/tbuild.ads | 3 | ||||
| -rw-r--r-- | gcc/ada/tree_io.adb | 6 | ||||
| -rw-r--r-- | gcc/ada/treepr.adb | 6 |
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)); |