Commit d4fc0fb4 by Arnaud Charlet

[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
parent 9c41193c
2010-06-18 Javier Miranda <miranda@adacore.com> 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 * exp_cg.adb, exp_cg.ads, exp_disp.adb, gnat1drv.adb: Add initial
support for dispatch table/callgraph info generation. support for dispatch table/callgraph info generation.
* gcc-interface/Make-lang.in: Update dependencies. * gcc-interface/Make-lang.in: Update dependencies.
......
...@@ -31,7 +31,7 @@ with Exp_Disp; use Exp_Disp; ...@@ -31,7 +31,7 @@ with Exp_Disp; use Exp_Disp;
with Exp_Tss; use Exp_Tss; with Exp_Tss; use Exp_Tss;
-- with Interfaces.C; -- with Interfaces.C;
-- with Interfaces.C_Streams; -- with Interfaces.C_Streams;
-- Why are these commented out ??? -- Why are these commented out ???
with Lib; use Lib; with Lib; use Lib;
with Namet; use Namet; with Namet; use Namet;
with Opt; use Opt; with Opt; use Opt;
...@@ -161,18 +161,16 @@ package body Exp_CG is ...@@ -161,18 +161,16 @@ package body Exp_CG is
-- Prefix "__" followed by number -- 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 else
pragma Assert (False); declare
raise Program_Error; 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 if; end if;
end Homonym_Suffix_Length; end Homonym_Suffix_Length;
......
...@@ -203,12 +203,44 @@ package body Freeze is ...@@ -203,12 +203,44 @@ package body Freeze is
New_S : Entity_Id; New_S : Entity_Id;
After : in out Node_Id) After : in out Node_Id)
is 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 begin
Insert_After (After, Body_Node);
Mark_Rewrite_Insertion (Body_Node); -- if the renamed subprogram is intrinsic, there is no need for a
Analyze (Body_Node); -- wrapper body: we set the alias that will be called and expanded
After := Body_Node; -- 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; end Build_And_Analyze_Renamed_Body;
------------------------ ------------------------
...@@ -308,8 +340,8 @@ package body Freeze is ...@@ -308,8 +340,8 @@ package body Freeze is
end if; end if;
-- For simple renamings, subsequent calls can be expanded directly as -- For simple renamings, subsequent calls can be expanded directly as
-- called to the renamed entity. The body must be generated in any case -- calls to the renamed entity. The body must be generated in any case
-- for calls they may appear elsewhere. -- for calls that may appear elsewhere.
if (Ekind (Old_S) = E_Function if (Ekind (Old_S) = E_Function
or else Ekind (Old_S) = E_Procedure) or else Ekind (Old_S) = E_Procedure)
...@@ -1340,6 +1372,9 @@ package body Freeze is ...@@ -1340,6 +1372,9 @@ package body Freeze is
-- point at which such functions are constructed (after all types that -- point at which such functions are constructed (after all types that
-- might be used in such expressions have been frozen). -- 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 -- We also add finalization chains to access types whose designated
-- types are controlled. This is normally done when freezing the type, -- types are controlled. This is normally done when freezing the type,
-- but this misses recursive type definitions where the later members -- but this misses recursive type definitions where the later members
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -29,9 +29,9 @@ ...@@ -29,9 +29,9 @@
-- -- -- --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- This package contains low level output routines used by the compiler -- This package contains low level output routines used by the compiler for
-- for writing error messages and informational output. It is also used -- writing error messages and informational output. It is also used by the
-- by the debug source file output routines (see Sprintf.Print_Eol). -- debug source file output routines (see Sprint.Print_Debug_Line).
with Hostparm; use Hostparm; with Hostparm; use Hostparm;
with Types; use Types; with Types; use Types;
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -32,6 +32,7 @@ ...@@ -32,6 +32,7 @@
-- tree may either blow up on a debugging check, or list incorrect source. -- tree may either blow up on a debugging check, or list incorrect source.
with Types; use Types; with Types; use Types;
package Sprint is package Sprint is
----------------------- -----------------------
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment