Skip to content

R
riscv-gcc-1
Commit 72348e26 by Arnaud Charlet
Options

[multiple changes] 

2012-01-10  Bob Duff  <duff@adacore.com>

	* sem_intr.adb (Check_Shift): Use RM_Size instead of Esize, when
	checking that the 'Size is correct. If the type is "mod 2**12",
	for example, it's illegal, but Esize is the 'Object_Size, which
	will be something like 16 or 32, so the error ('Size = 12) was
	not detected.
	* gnat_rm.texi: Improve documentation of shift
	and rotate intrinsics.

2012-01-10  Pascal Obry  <obry@adacore.com>

	* prj.adb (For_Every_Project_Imported): Fix
	implementation to make sure we return each project only once
	for aggragte libraries. It is fine to return a project twice for
	aggregate projects, this was the case as a Project_Id is different
	in each project tree. The new implementation use a table based on
	the project name to ensure proper detection of duplicate project
	in aggregate library. A new context is then created to continue
	retrurning duplicate project for aggregate libraries.

From-SVN: r183059
parent cba300dd
Showing with 140 additions and 120 deletions
gcc/ada/ChangeLog
2012-01-10 Bob Duff <duff@adacore.com>
* sem_intr.adb (Check_Shift): Use RM_Size instead of Esize, when
checking that the 'Size is correct. If the type is "mod 2**12",
for example, it's illegal, but Esize is the 'Object_Size, which
will be something like 16 or 32, so the error ('Size = 12) was
not detected.
* gnat_rm.texi: Improve documentation of shift
and rotate intrinsics.
2012-01-10 Pascal Obry <obry@adacore.com>
* prj.adb (For_Every_Project_Imported): Fix
implementation to make sure we return each project only once
for aggragte libraries. It is fine to return a project twice for
aggregate projects, this was the case as a Project_Id is different
in each project tree. The new implementation use a table based on
the project name to ensure proper detection of duplicate project
in aggregate library. A new context is then created to continue
retrurning duplicate project for aggregate libraries.
2012-01-09 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/trans.c (call_to_gnu): Create the temporary for the
......
gcc/ada/gnat_rm.texi
......@@ -10385,11 +10385,7 @@ There are no restrictions on pragma @code{Restrictions}.
* Exception_Name::
* File::
* Line::
* Rotate_Left::
* Rotate_Right::
* Shift_Left::
* Shift_Right::
* Shift_Right_Arithmetic::
* Shifts and Rotates::
* Source_Location::
@end menu
......@@ -10506,61 +10502,35 @@ application program should simply call the function
@code{GNAT.Source_Info.Line} to obtain the number of the current
source line.
@node Rotate_Left
@section Rotate_Left
@node Shifts and Rotates
@section Shifts and Rotates
@cindex Shift_Left
@cindex Shift_Right
@cindex Shift_Right_Arithmetic
@cindex Rotate_Left
@cindex Rotate_Right
@noindent
In standard Ada, the @code{Rotate_Left} function is available only
In standard Ada, the shift and rotate functions are available only
for the predefined modular types in package @code{Interfaces}. However, in
GNAT it is possible to define a Rotate_Left function for a user
defined modular type or any signed integer type as in this example:
GNAT it is possible to define these functions for any integer
type (signed or modular), as in this example:
@smallexample @c ada
function Shift_Left
(Value : My_Modular_Type;
(Value : T;
Amount : Natural)
return My_Modular_Type;
return T;
@end smallexample
@noindent
The requirements are that the profile be exactly as in the example
above. The only modifications allowed are in the formal parameter
names, and in the type of @code{Value} and the return type, which
must be the same, and must be either a signed integer type, or
a modular integer type with a binary modulus, and the size must
be 8. 16, 32 or 64 bits.
@node Rotate_Right
@section Rotate_Right
@cindex Rotate_Right
@noindent
A @code{Rotate_Right} function can be defined for any user defined
binary modular integer type, or signed integer type, as described
above for @code{Rotate_Left}.
@node Shift_Left
@section Shift_Left
@cindex Shift_Left
@noindent
A @code{Shift_Left} function can be defined for any user defined
binary modular integer type, or signed integer type, as described
above for @code{Rotate_Left}.
@node Shift_Right
@section Shift_Right
@cindex Shift_Right
@noindent
A @code{Shift_Right} function can be defined for any user defined
binary modular integer type, or signed integer type, as described
above for @code{Rotate_Left}.
@node Shift_Right_Arithmetic
@section Shift_Right_Arithmetic
@cindex Shift_Right_Arithmetic
@noindent
A @code{Shift_Right_Arithmetic} function can be defined for any user
defined binary modular integer type, or signed integer type, as described
above for @code{Rotate_Left}.
The function name must be one of
Shift_Left, Shift_Right, Shift_Right_Arithmetic, Rotate_Left, or
Rotate_Right. T must be an integer type. T'Size must be
8, 16, 32 or 64 bits; if T is modular, the modulus
must be 2**8, 2**16, 2**32 or 2**64.
The result type must be the same as the type of @code{Value}.
The shift amount must be Natural.
The formal parameter names can be anything.
@node Source_Location
@section Source_Location
......
gcc/ada/prj.adb
......@@ -34,6 +34,7 @@ with Snames; use Snames;
with Uintp; use Uintp;
with Ada.Characters.Handling; use Ada.Characters.Handling;
with Ada.Containers.Ordered_Sets;
with Ada.Unchecked_Deallocation;
with GNAT.Case_Util; use GNAT.Case_Util;
......@@ -523,101 +524,128 @@ package body Prj is
Include_Aggregated : Boolean := True;
Imported_First : Boolean := False)
is
use Project_Boolean_Htable;
Seen : Project_Boolean_Htable.Instance := Project_Boolean_Htable.Nil;
procedure Recursive_Check
procedure Recursive_Check_Context
(Project : Project_Id;
Tree : Project_Tree_Ref;
In_Aggregate_Lib : Boolean);
-- Check if a project has already been seen. If not seen, mark it
-- as Seen, Call Action, and check all its imported and aggregated
-- projects.
-- Recursively handle the project tree creating a new context for
-- keeping track about already handled projects.
---------------------
-- Recursive_Check --
---------------------
-----------------------------
-- Recursive_Check_Context --
-----------------------------
procedure Recursive_Check
procedure Recursive_Check_Context
(Project : Project_Id;
Tree : Project_Tree_Ref;
In_Aggregate_Lib : Boolean)
is
List : Project_List;
T : Project_Tree_Ref;
package Name_Id_Set is
new Ada.Containers.Ordered_Sets (Element_Type => Name_Id);
begin
if not Get (Seen, Project) then
Seen_Name : Name_Id_Set.Set;
-- This set is needed to ensure that we do not haandle the same
-- project twice in the context of aggregate libraries.
-- Even if a project is aggregated multiple times, we will only
-- return it once.
procedure Recursive_Check
(Project : Project_Id;
Tree : Project_Tree_Ref;
In_Aggregate_Lib : Boolean);
-- Check if project has already been seen. If not, mark it as Seen,
-- Call Action, and check all its imported and aggregated projects.
Set (Seen, Project, True);
---------------------
-- Recursive_Check --
---------------------
if not Imported_First then
Action (Project, Tree, In_Aggregate_Lib, With_State);
end if;
procedure Recursive_Check
(Project : Project_Id;
Tree : Project_Tree_Ref;
In_Aggregate_Lib : Boolean)
is
List : Project_List;
T : Project_Tree_Ref;
begin
if not Seen_Name.Contains (Project.Name) then
-- Visit all extended projects
-- Even if a project is aggregated multiple times in an
-- aggregated library, we will only return it once.
if Project.Extends /= No_Project then
Recursive_Check (Project.Extends, Tree, In_Aggregate_Lib);
end if;
Seen_Name.Include (Project.Name);
-- Visit all imported projects if needed. This is not needed
-- for an aggregate library as imported libraries are just
-- there for dependency support.
if not Imported_First then
Action (Project, Tree, In_Aggregate_Lib, With_State);
end if;
-- Visit all extended projects
if Project.Extends /= No_Project then
Recursive_Check (Project.Extends, Tree, In_Aggregate_Lib);
end if;
-- Visit all imported projects
if Project.Qualifier /= Aggregate_Library
or else not Include_Aggregated
then
List := Project.Imported_Projects;
while List /= null loop
Recursive_Check (List.Project, Tree, In_Aggregate_Lib);
List := List.Next;
end loop;
end if;
-- Visit all aggregated projects
-- Visit all aggregated projects
if Include_Aggregated
and then Project.Qualifier in Aggregate_Project
then
declare
Agg : Aggregated_Project_List;
begin
Agg := Project.Aggregated_Projects;
while Agg /= null loop
pragma Assert (Agg.Project /= No_Project);
-- For aggregated libraries, the tree must be the one
-- of the aggregate library.
if Project.Qualifier = Aggregate_Library then
T := Tree;
else
T := Agg.Tree;
end if;
Recursive_Check
(Agg.Project, T, Project.Qualifier = Aggregate_Library);
Agg := Agg.Next;
end loop;
end;
end if;
if Include_Aggregated
and then Project.Qualifier in Aggregate_Project
then
declare
Agg : Aggregated_Project_List;
begin
Agg := Project.Aggregated_Projects;
while Agg /= null loop
pragma Assert (Agg.Project /= No_Project);
-- For aggregated libraries, the tree must be the one
-- of the aggregate library.
if Project.Qualifier = Aggregate_Library then
T := Tree;
Recursive_Check (Agg.Project, T, True);
else
T := Agg.Tree;
-- Use a new context as we want to returns the same
-- project in different project tree for aggregated
-- projects.
if Imported_First then
Action (Project, Tree, In_Aggregate_Lib, With_State);
Recursive_Check_Context (Agg.Project, T, False);
end if;
Agg := Agg.Next;
end loop;
end;
end if;
if Imported_First then
Action (Project, Tree, In_Aggregate_Lib, With_State);
end if;
end if;
end if;
end Recursive_Check;
end Recursive_Check;
-- Start of processing for Recursive_Check_Context
begin
Recursive_Check (Project, Tree, In_Aggregate_Lib);
end Recursive_Check_Context;
-- Start of processing for For_Every_Project_Imported
begin
Recursive_Check (Project => By, Tree => Tree, In_Aggregate_Lib => False);
Reset (Seen);
Recursive_Check_Context
(Project => By, Tree => Tree, In_Aggregate_Lib => False);
end For_Every_Project_Imported;
-----------------
......
gcc/ada/sem_intr.adb
......@@ -455,12 +455,14 @@ package body Sem_Intr is
return;
end if;
Size := UI_To_Int (Esize (Typ1));
-- type'Size (not 'Object_Size!) must be one of the allowed values
if Size /= 8
and then Size /= 16
and then Size /= 32
and then Size /= 64
Size := UI_To_Int (RM_Size (Typ1));
if Size /= 8 and then
Size /= 16 and then
Size /= 32 and then
Size /= 64
then
Errint
("first argument for shift must have size 8, 16, 32 or 64",
......@@ -469,8 +471,7 @@ package body Sem_Intr is
elsif Non_Binary_Modulus (Typ1) then
Errint
("shifts not allowed for non-binary modular types",
Ptyp1, N);
("shifts not allowed for non-binary modular types", Ptyp1, N);
elsif Etype (Arg1) /= Etype (E) then
Errint
......
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