From d4fc0fb47f2fbc0910178660cffdf6f0b209fad9 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Fri, 18 Jun 2010 17:32:24 +0200 Subject: [PATCH] [multiple changes] 2010-06-18 Javier Miranda * exp_cg.adb (Homonym_Suffix_Length): Minor code reorganization. 2010-06-18 Thomas Quinot * sprint.ads: Minor reformatting. * output.ads: Update obsolete comment. 2010-06-18 Ed Schonberg * freeze.adb (Build_And_Analyze_Renamed_Body): if the renamed entity is an external intrinsic operation (e.g. a GCC numeric function) indicate that the renaming entity has the same characteristics, so a call to it is properly expanded. From-SVN: r160999 --- gcc/ada/ChangeLog | 16 +++++++++++++++ gcc/ada/exp_cg.adb | 22 ++++++++++----------- gcc/ada/freeze.adb | 49 +++++++++++++++++++++++++++++++++++++++------- gcc/ada/output.ads | 8 ++++---- gcc/ada/sprint.ads | 3 ++- 5 files changed, 74 insertions(+), 24 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 5e3968ec480..30b6acb8661 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,19 @@ +2010-06-18 Javier Miranda + + * exp_cg.adb (Homonym_Suffix_Length): Minor code reorganization. + +2010-06-18 Thomas Quinot + + * sprint.ads: Minor reformatting. + * output.ads: Update obsolete comment. + +2010-06-18 Ed Schonberg + + * freeze.adb (Build_And_Analyze_Renamed_Body): if the renamed entity is + an external intrinsic operation (e.g. a GCC numeric function) indicate + that the renaming entity has the same characteristics, so a call to it + is properly expanded. + 2010-06-18 Javier Miranda * exp_cg.adb, exp_cg.ads, exp_disp.adb, gnat1drv.adb: Add initial diff --git a/gcc/ada/exp_cg.adb b/gcc/ada/exp_cg.adb index 2b735e34202..d207a3c21e1 100644 --- a/gcc/ada/exp_cg.adb +++ b/gcc/ada/exp_cg.adb @@ -31,7 +31,7 @@ with Exp_Disp; use Exp_Disp; with Exp_Tss; use Exp_Tss; -- with Interfaces.C; -- with Interfaces.C_Streams; --- Why are these commented out ??? +-- Why are these commented out ??? with Lib; use Lib; with Namet; use Namet; with Opt; use Opt; @@ -161,18 +161,16 @@ package body Exp_CG is -- Prefix "__" followed by number - elsif Nr < 10 then - return Prefix_Length + 1; - - elsif Nr < 100 then - return Prefix_Length + 2; - - elsif Nr < 1000 then - return Prefix_Length + 3; - else - pragma Assert (False); - raise Program_Error; + declare + Result : Natural := Prefix_Length + 1; + begin + while Nr > 10 loop + Result := Result + 1; + Nr := Nr / 10; + end loop; + return Result; + end; end if; end if; end Homonym_Suffix_Length; diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 1c24d74a4fb..289730704cd 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -203,12 +203,44 @@ package body Freeze is New_S : Entity_Id; After : in out Node_Id) is - Body_Node : constant Node_Id := Build_Renamed_Body (Decl, New_S); + Body_Node : Node_Id; + Intr : Entity_Id; + Body_Decl : constant Node_Id := Unit_Declaration_Node (New_S); + Ent : constant Entity_Id := Defining_Entity (Decl); + begin - Insert_After (After, Body_Node); - Mark_Rewrite_Insertion (Body_Node); - Analyze (Body_Node); - After := Body_Node; + + -- if the renamed subprogram is intrinsic, there is no need for a + -- wrapper body: we set the alias that will be called and expanded + -- which completes the declaration. + -- Note that it is legal for a renaming_as_body to rename an intrinsic + -- subprogram, as long as the renaming occurs before the new entity + -- is frozen. See RM 8.5.4 (5). + + if Nkind (Body_Decl) = N_Subprogram_Renaming_Declaration + and then Is_Entity_Name (Name (Body_Decl)) + and then Is_Intrinsic_Subprogram (Entity (Name (Body_Decl))) + and then Present (Interface_Name (Entity (Name (Body_Decl)))) + then + Intr := Entity (Name (Body_Decl)); + Set_Interface_Name + (Intr, Interface_Name (Entity (Name (Body_Decl)))); + if Present (Alias (Intr)) then + Set_Alias (Ent, Alias (Intr)); + else + Set_Alias (Ent, Intr); + end if; + + Set_Is_Intrinsic_Subprogram (Ent); + Set_Has_Completion (Ent); + + else + Body_Node := Build_Renamed_Body (Decl, New_S); + Insert_After (After, Body_Node); + Mark_Rewrite_Insertion (Body_Node); + Analyze (Body_Node); + After := Body_Node; + end if; end Build_And_Analyze_Renamed_Body; ------------------------ @@ -308,8 +340,8 @@ package body Freeze is end if; -- For simple renamings, subsequent calls can be expanded directly as - -- called to the renamed entity. The body must be generated in any case - -- for calls they may appear elsewhere. + -- calls to the renamed entity. The body must be generated in any case + -- for calls that may appear elsewhere. if (Ekind (Old_S) = E_Function or else Ekind (Old_S) = E_Procedure) @@ -1340,6 +1372,9 @@ package body Freeze is -- point at which such functions are constructed (after all types that -- might be used in such expressions have been frozen). + -- For subprograms that are renaming_as_body, we create the wrapper + -- bodies as needed. + -- We also add finalization chains to access types whose designated -- types are controlled. This is normally done when freezing the type, -- but this misses recursive type definitions where the later members diff --git a/gcc/ada/output.ads b/gcc/ada/output.ads index 7f13dc24b15..2df0da661e5 100644 --- a/gcc/ada/output.ads +++ b/gcc/ada/output.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2010, 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- -- @@ -29,9 +29,9 @@ -- -- ------------------------------------------------------------------------------ --- This package contains low level output routines used by the compiler --- for writing error messages and informational output. It is also used --- by the debug source file output routines (see Sprintf.Print_Eol). +-- This package contains low level output routines used by the compiler for +-- writing error messages and informational output. It is also used by the +-- debug source file output routines (see Sprint.Print_Debug_Line). with Hostparm; use Hostparm; with Types; use Types; diff --git a/gcc/ada/sprint.ads b/gcc/ada/sprint.ads index 7c2b3cb0a21..64fe81ae4c5 100644 --- a/gcc/ada/sprint.ads +++ b/gcc/ada/sprint.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2010, 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 @@ -- tree may either blow up on a debugging check, or list incorrect source. with Types; use Types; + package Sprint is ----------------------- -- 2.30.2