diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index d49a0c7c79f..1f92e12c202 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,19 @@ +2001-12-05 Robert Dewar + + * checks.adb (Determine_Range): Increase cache size for checks. + Minor reformatting + + * exp_ch6.adb: Minor reformatting + (Expand_N_Subprogram_Body): Reset Is_Pure for any subprogram that has + a parameter whose root type is System.Address, since treating such + subprograms as pure in the code generator is almost surely a mistake + that will lead to unexpected results. + + * exp_util.adb (Remove_Side_Effects): Clean up old ??? comment and + change handling of conversions. + + * g-regexp.adb: Use System.IO instead of Ada.Text_IO. + 2001-12-05 Ed Schonberg * sem_ch3.adb (Analyze_Object_Declaration): If expression is an diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 27ccc084493..67723b5b986 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -1863,7 +1863,7 @@ package body Checks is -- Determine_Range -- --------------------- - Cache_Size : constant := 2 ** 6; + Cache_Size : constant := 2 ** 10; type Cache_Index is range 0 .. Cache_Size - 1; -- Determine size of below cache (power of 2 is more efficient!) @@ -2705,7 +2705,7 @@ package body Checks is -- validity checks on the validity checking code itself! else - Validity_Checks_On := False; + Validity_Checks_On := False; Insert_Action (Expr, Make_Raise_Constraint_Error (Loc, diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 493a8c11854..9930904d39d 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- $Revision: 1.1 $ +-- $Revision$ -- -- -- Copyright (C) 1992-2001, Free Software Foundation, Inc. -- -- -- @@ -150,9 +150,9 @@ package body Exp_Ch6 is -- reference to the object itself, and the call becomes a call to the -- corresponding protected subprogram. - --------------------------------- - -- Check_Overriding_Operation -- - --------------------------------- + -------------------------------- + -- Check_Overriding_Operation -- + -------------------------------- procedure Check_Overriding_Operation (Subp : Entity_Id) is Typ : constant Entity_Id := Find_Dispatching_Type (Subp); @@ -2659,9 +2659,12 @@ package body Exp_Ch6 is -- Initialize scalar out parameters if Initialize/Normalize_Scalars + -- Reset Pure indication if any parameter has root type System.Address + procedure Expand_N_Subprogram_Body (N : Node_Id) is Loc : constant Source_Ptr := Sloc (N); H : constant Node_Id := Handled_Statement_Sequence (N); + Body_Id : Entity_Id; Spec_Id : Entity_Id; Except_H : Node_Id; Scop : Entity_Id; @@ -2712,17 +2715,47 @@ package body Exp_Ch6 is -- Find entity for subprogram + Body_Id := Defining_Entity (N); + if Present (Corresponding_Spec (N)) then Spec_Id := Corresponding_Spec (N); else - Spec_Id := Defining_Entity (N); + Spec_Id := Body_Id; + end if; + + -- If this is a Pure function which has any parameters whose root + -- type is System.Address, reset the Pure indication, since it will + -- likely cause incorrect code to be generated. + + if Is_Pure (Spec_Id) + and then Is_Subprogram (Spec_Id) + and then not Has_Pragma_Pure_Function (Spec_Id) + then + declare + F : Entity_Id := First_Formal (Spec_Id); + + begin + while Present (F) loop + if Is_RTE (Root_Type (Etype (F)), RE_Address) then + Set_Is_Pure (Spec_Id, False); + + if Spec_Id /= Body_Id then + Set_Is_Pure (Body_Id, False); + end if; + + exit; + end if; + + Next_Formal (F); + end loop; + end; end if; -- Initialize any scalar OUT args if Initialize/Normalize_Scalars if Init_Or_Norm_Scalars and then Is_Subprogram (Spec_Id) then declare - F : Entity_Id := First_Formal (Spec_Id); + F : Entity_Id := First_Formal (Spec_Id); V : constant Boolean := Validity_Checks_On; begin @@ -2881,7 +2914,6 @@ package body Exp_Ch6 is Set_Privals (Dec, Next_Op, Loc); Set_Discriminals (Dec, Next_Op, Loc); end if; - end if; -- If subprogram contains a parameterless recursive call, then we may diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index a0a4d01b1ed..8f64f1634fb 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -2861,13 +2861,13 @@ package body Exp_Util is -- circumstances: for change of representations, and also when this -- is a view conversion to a smaller object, where gigi can end up -- its own temporary of the wrong size. + -- ??? this transformation is inhibited for elementary types that are -- not involved in a change of representation because it causes -- regressions that are not fully understood yet. elsif Nkind (Exp) = N_Type_Conversion - and then (not Is_Elementary_Type (Underlying_Type (Exp_Type)) - or else Nkind (Parent (Exp)) = N_Assignment_Statement) + and then not Name_Req then Remove_Side_Effects (Expression (Exp), Variable_Ref); Scope_Suppress := Svg_Suppress; diff --git a/gcc/ada/g-regexp.adb b/gcc/ada/g-regexp.adb index 302b63a7832..360badc69ea 100644 --- a/gcc/ada/g-regexp.adb +++ b/gcc/ada/g-regexp.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- $Revision: 1.27 $ +-- $Revision$ -- -- -- Copyright (C) 1999-2001 Ada Core Technologies, Inc. -- -- -- @@ -32,7 +32,7 @@ -- -- ------------------------------------------------------------------------------ -with Ada.Text_IO; +with System.IO; with Unchecked_Deallocation; with Ada.Exceptions; with GNAT.Case_Util; @@ -1226,8 +1226,8 @@ package body GNAT.Regexp is end loop; if Debug then - Ada.Text_IO.New_Line; - Ada.Text_IO.Put_Line ("Secondary table : "); + System.IO.New_Line; + System.IO.Put_Line ("Secondary table : "); Print_Table (R.States, Nb_State, False); end if; @@ -1267,39 +1267,39 @@ package body GNAT.Regexp is begin -- Print the header line - Ada.Text_IO.Put (" [*] "); + System.IO.Put (" [*] "); for Column in 1 .. Alphabet_Size loop - Ada.Text_IO.Put (String'(1 .. 1 => Reverse_Mapping (Column)) - & " "); + System.IO.Put + (String'(1 .. 1 => Reverse_Mapping (Column)) & " "); end loop; if Is_Primary then - Ada.Text_IO.Put ("closure...."); + System.IO.Put ("closure...."); end if; - Ada.Text_IO.New_Line; + System.IO.New_Line; -- Print every line for State in 1 .. Num_States loop - Ada.Text_IO.Put (State'Img); + System.IO.Put (State'Img); for K in 1 .. 3 - State'Img'Length loop - Ada.Text_IO.Put (" "); + System.IO.Put (" "); end loop; for K in 0 .. Alphabet_Size loop - Ada.Text_IO.Put (Table (State, K)'Img & " "); + System.IO.Put (Table (State, K)'Img & " "); end loop; for K in Alphabet_Size + 1 .. Table'Last (2) loop if Table (State, K) /= 0 then - Ada.Text_IO.Put (Table (State, K)'Img & ","); + System.IO.Put (Table (State, K)'Img & ","); end if; end loop; - Ada.Text_IO.New_Line; + System.IO.New_Line; end loop; end Print_Table; @@ -1347,8 +1347,8 @@ package body GNAT.Regexp is if Debug then Print_Table (Table.all, Num_States); - Ada.Text_IO.Put_Line ("Start_State : " & Start_State'Img); - Ada.Text_IO.Put_Line ("End_State : " & End_State'Img); + System.IO.Put_Line ("Start_State : " & Start_State'Img); + System.IO.Put_Line ("End_State : " & End_State'Img); end if; -- Creates the secondary table @@ -1453,13 +1453,14 @@ package body GNAT.Regexp is New_Table.all := (others => (others => 0)); if Debug then - Ada.Text_IO.Put_Line ("Reallocating table: Lines from " - & State_Index'Image (Table'Last (1)) & " to " - & State_Index'Image (New_Lines)); - Ada.Text_IO.Put_Line (" and columns from " - & Column_Index'Image (Table'Last (2)) - & " to " - & Column_Index'Image (New_Columns)); + System.IO.Put_Line ("Reallocating table: Lines from " + & State_Index'Image (Table'Last (1)) + & " to " + & State_Index'Image (New_Lines)); + System.IO.Put_Line (" and columns from " + & Column_Index'Image (Table'Last (2)) + & " to " + & Column_Index'Image (New_Columns)); end if; for J in Table'Range (1) loop