This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Ada] Miscellaneous fixes/reformatting/cleanup
- From: Geert Bosch <bosch at darwin dot gnat dot com>
- To: gcc-patches at gcc dot gnu dot org
- Date: Wed, 5 Dec 2001 14:55:01 -0500 (EST)
- Subject: [Ada] Miscellaneous fixes/reformatting/cleanup
2001-12-05 Robert Dewar <dewar@gnat.com>
* 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.
*** checks.adb 2001/10/03 17:49:37 1.206
--- checks.adb 2001/10/21 10:12:21 1.207
***************
*** 1863,1869 ****
-- Determine_Range --
---------------------
! Cache_Size : constant := 2 ** 6;
type Cache_Index is range 0 .. Cache_Size - 1;
-- Determine size of below cache (power of 2 is more efficient!)
--- 1863,1869 ----
-- Determine_Range --
---------------------
! 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,2711 ****
-- validity checks on the validity checking code itself!
else
! Validity_Checks_On := False;
Insert_Action
(Expr,
Make_Raise_Constraint_Error (Loc,
--- 2705,2711 ----
-- validity checks on the validity checking code itself!
else
! Validity_Checks_On := False;
Insert_Action
(Expr,
Make_Raise_Constraint_Error (Loc,
*** exp_ch6.adb 2001/09/23 23:19:18 1.343
--- exp_ch6.adb 2001/10/21 10:18:38 1.344
***************
*** 150,158 ****
-- reference to the object itself, and the call becomes a call to the
-- corresponding protected subprogram.
! ---------------------------------
! -- Check_Overriding_Operation --
! ---------------------------------
procedure Check_Overriding_Operation (Subp : Entity_Id) is
Typ : constant Entity_Id := Find_Dispatching_Type (Subp);
--- 150,158 ----
-- reference to the object itself, and the call becomes a call to the
-- corresponding protected subprogram.
! --------------------------------
! -- Check_Overriding_Operation --
! --------------------------------
procedure Check_Overriding_Operation (Subp : Entity_Id) is
Typ : constant Entity_Id := Find_Dispatching_Type (Subp);
***************
*** 2659,2667 ****
--- 2659,2670 ----
-- 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,2728 ****
-- Find entity for subprogram
if Present (Corresponding_Spec (N)) then
Spec_Id := Corresponding_Spec (N);
else
! Spec_Id := Defining_Entity (N);
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);
V : constant Boolean := Validity_Checks_On;
begin
--- 2715,2761 ----
-- Find entity for subprogram
+ Body_Id := Defining_Entity (N);
+
if Present (Corresponding_Spec (N)) then
Spec_Id := Corresponding_Spec (N);
else
! 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);
V : constant Boolean := Validity_Checks_On;
begin
***************
*** 2881,2887 ****
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
--- 2914,2919 ----
*** exp_util.adb 2001/10/10 15:31:01 1.334
--- exp_util.adb 2001/10/21 10:46:30 1.335
***************
*** 2861,2873 ****
-- 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)
then
Remove_Side_Effects (Expression (Exp), Variable_Ref);
Scope_Suppress := Svg_Suppress;
--- 2861,2873 ----
-- 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 Name_Req
then
Remove_Side_Effects (Expression (Exp), Variable_Ref);
Scope_Suppress := Svg_Suppress;
*** g-regexp.adb 2001/07/05 14:00:21 1.27
--- g-regexp.adb 2001/10/21 11:04:16 1.28
***************
*** 32,38 ****
-- --
------------------------------------------------------------------------------
! with Ada.Text_IO;
with Unchecked_Deallocation;
with Ada.Exceptions;
with GNAT.Case_Util;
--- 32,38 ----
-- --
------------------------------------------------------------------------------
! with System.IO;
with Unchecked_Deallocation;
with Ada.Exceptions;
with GNAT.Case_Util;
***************
*** 1226,1233 ****
end loop;
if Debug then
! Ada.Text_IO.New_Line;
! Ada.Text_IO.Put_Line ("Secondary table : ");
Print_Table (R.States, Nb_State, False);
end if;
--- 1226,1233 ----
end loop;
if Debug then
! System.IO.New_Line;
! System.IO.Put_Line ("Secondary table : ");
Print_Table (R.States, Nb_State, False);
end if;
***************
*** 1267,1305 ****
begin
-- Print the header line
! Ada.Text_IO.Put (" [*] ");
for Column in 1 .. Alphabet_Size loop
! Ada.Text_IO.Put (String'(1 .. 1 => Reverse_Mapping (Column))
! & " ");
end loop;
if Is_Primary then
! Ada.Text_IO.Put ("closure....");
end if;
! Ada.Text_IO.New_Line;
-- Print every line
for State in 1 .. Num_States loop
! Ada.Text_IO.Put (State'Img);
for K in 1 .. 3 - State'Img'Length loop
! Ada.Text_IO.Put (" ");
end loop;
for K in 0 .. Alphabet_Size loop
! Ada.Text_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 & ",");
end if;
end loop;
! Ada.Text_IO.New_Line;
end loop;
end Print_Table;
--- 1267,1305 ----
begin
-- Print the header line
! System.IO.Put (" [*] ");
for Column in 1 .. Alphabet_Size loop
! System.IO.Put
! (String'(1 .. 1 => Reverse_Mapping (Column)) & " ");
end loop;
if Is_Primary then
! System.IO.Put ("closure....");
end if;
! System.IO.New_Line;
-- Print every line
for State in 1 .. Num_States loop
! System.IO.Put (State'Img);
for K in 1 .. 3 - State'Img'Length loop
! System.IO.Put (" ");
end loop;
for K in 0 .. Alphabet_Size loop
! 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
! System.IO.Put (Table (State, K)'Img & ",");
end if;
end loop;
! System.IO.New_Line;
end loop;
end Print_Table;
***************
*** 1347,1354 ****
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);
end if;
-- Creates the secondary table
--- 1347,1354 ----
if Debug then
Print_Table (Table.all, Num_States);
! 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,1465 ****
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));
end if;
for J in Table'Range (1) loop
--- 1453,1466 ----
New_Table.all := (others => (others => 0));
if Debug then
! 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