[multiple changes]

2010-06-18  Javier Miranda  <miranda@adacore.com>

	* exp_cg.adb (Homonym_Suffix_Length): Minor code reorganization.

2010-06-18  Thomas Quinot  <quinot@adacore.com>

	* sprint.ads: Minor reformatting.
	* output.ads: Update obsolete comment.

2010-06-18  Ed Schonberg  <schonberg@adacore.com>

	* 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
This commit is contained in:
Arnaud Charlet 2010-06-18 17:32:24 +02:00
parent 9c41193c1d
commit d4fc0fb47f
5 changed files with 74 additions and 24 deletions

View File

@ -1,3 +1,19 @@
2010-06-18 Javier Miranda <miranda@adacore.com>
* exp_cg.adb (Homonym_Suffix_Length): Minor code reorganization.
2010-06-18 Thomas Quinot <quinot@adacore.com>
* sprint.ads: Minor reformatting.
* output.ads: Update obsolete comment.
2010-06-18 Ed Schonberg <schonberg@adacore.com>
* 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 <miranda@adacore.com>
* exp_cg.adb, exp_cg.ads, exp_disp.adb, gnat1drv.adb: Add initial

View File

@ -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;

View File

@ -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

View File

@ -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;

View File

@ -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
-----------------------