Skip to content

R
riscv-gcc-1
Commit 457c5df4 by Arnaud Charlet
Options

[multiple changes] 

2012-01-30  Vincent Pucci  <pucci@adacore.com>

	* sem_dim.adb (Expand_Put_Call_With_Dimension_Symbol): Minor
	code clean up.
	* s-diflio.ads: Minor change.

2012-01-30  Javier Miranda  <miranda@adacore.com>

	* exp_ch9.adb (Build_Dispatching_Requeue): Add missing call
	to Get_Entry_Index.  Required to generate code which provides
	the correct value of Entry_Index in the target entry.

2012-01-30  Nicolas Roche  <roche@adacore.com>

	* system-vxworks-ppc.ads: Add pragma Linker_Options -crtbe to
	fix issue with zcx on VxWorks5.

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

	* prj.ads, prj.adb (For_Every_Project_Imported): Remove
	In_Aggregate_Lib.
	(For_Every_Project_Imported_Context): New generic routine with
	a context parameter.
	* prj-nmsc.adb: Revert to use For_Every_Project_Imported Avoid
	distributed complexity.
	* prj-env.adb, prj-conf.adb, makeutl.adb, gnatcmd.adb: Ditto.

From-SVN: r183702
parent 1b6897ce
Showing with 303 additions and 192 deletions
gcc/ada/ChangeLog
2012-01-30 Vincent Pucci <pucci@adacore.com>
* sem_dim.adb (Expand_Put_Call_With_Dimension_Symbol): Minor
code clean up.
* s-diflio.ads: Minor change.
2012-01-30 Javier Miranda <miranda@adacore.com>
* exp_ch9.adb (Build_Dispatching_Requeue): Add missing call
to Get_Entry_Index. Required to generate code which provides
the correct value of Entry_Index in the target entry.
2012-01-30 Nicolas Roche <roche@adacore.com>
* system-vxworks-ppc.ads: Add pragma Linker_Options -crtbe to
fix issue with zcx on VxWorks5.
2012-01-30 Pascal Obry <obry@adacore.com>
* prj.ads, prj.adb (For_Every_Project_Imported): Remove
In_Aggregate_Lib.
(For_Every_Project_Imported_Context): New generic routine with
a context parameter.
* prj-nmsc.adb: Revert to use For_Every_Project_Imported Avoid
distributed complexity.
* prj-env.adb, prj-conf.adb, makeutl.adb, gnatcmd.adb: Ditto.
2012-01-30 Thomas Quinot <quinot@adacore.com>
* exp_aggr.adb (Expand_Record_Aggregate): After creating the
......
gcc/ada/exp_ch9.adb
......@@ -9022,42 +9022,68 @@ package body Exp_Ch9 is
-- Process the entry wrapper's position in the primary dispatch
-- table parameter. Generate:
-- Ada.Tags.Get_Offset_Index
-- (Ada.Tags.Tag (Concval),
-- <interface dispatch table position of Ename>)
-- Ada.Tags.Get_Entry_Index
-- (T => To_Tag_Ptr (Obj'Address).all,
-- Position => Ada.Tags.Get_Offset_Index
-- (Ada.Tags.Tag (Concval),
-- i <interface dispatch table position of Ename>));
-- Note that Obj'Address is recursively expanded into a call to
-- Base_Address (Obj)
if Tagged_Type_Expansion then
Prepend_To (Params,
Make_Function_Call (Loc,
Name => New_Reference_To (RTE (RE_Get_Offset_Index), Loc),
Name => New_Reference_To (RTE (RE_Get_Entry_Index), Loc),
Parameter_Associations => New_List (
Unchecked_Convert_To (RTE (RE_Tag), Concval),
Make_Integer_Literal (Loc, DT_Position (Entity (Ename))))));
Make_Explicit_Dereference (Loc,
Unchecked_Convert_To (RTE (RE_Tag_Ptr),
Make_Attribute_Reference (Loc,
Prefix => New_Copy_Tree (Concval),
Attribute_Name => Name_Address))),
Make_Function_Call (Loc,
Name => New_Reference_To (RTE (RE_Get_Offset_Index), Loc),
Parameter_Associations => New_List (
Unchecked_Convert_To (RTE (RE_Tag), Concval),
Make_Integer_Literal (Loc,
DT_Position (Entity (Ename))))))));
-- VM targets
else
Prepend_To (Params,
Make_Function_Call (Loc,
Name => New_Reference_To (RTE (RE_Get_Offset_Index), Loc),
Make_Function_Call (Loc,
Name => New_Reference_To (RTE (RE_Get_Entry_Index), Loc),
Parameter_Associations => New_List (
-- Obj_Typ
Make_Attribute_Reference (Loc,
Prefix => Concval,
Attribute_Name => Name_Tag),
-- Tag_Typ
Make_Function_Call (Loc,
Name => New_Reference_To (RTE (RE_Get_Offset_Index), Loc),
Make_Attribute_Reference (Loc,
Prefix => New_Reference_To (Etype (Concval), Loc),
Attribute_Name => Name_Tag),
Parameter_Associations => New_List (
-- Obj_Tag
Make_Attribute_Reference (Loc,
Prefix => Concval,
Attribute_Name => Name_Tag),
-- Tag_Typ
Make_Attribute_Reference (Loc,
Prefix => New_Reference_To (Etype (Concval), Loc),
Attribute_Name => Name_Tag),
-- Position
-- Position
Make_Integer_Literal (Loc, DT_Position (Entity (Ename))))));
Make_Integer_Literal (Loc,
DT_Position (Entity (Ename))))))));
end if;
-- Specific actuals for protected to XXX requeue
......
gcc/ada/gnatcmd.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1996-2011, Free Software Foundation, Inc. --
-- Copyright (C) 1996-2012, 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- --
......@@ -264,7 +264,6 @@ procedure GNATCmd is
procedure Set_Library_For
(Project : Project_Id;
Tree : Project_Tree_Ref;
In_Aggregate_Lib : Boolean;
Libraries_Present : in out Boolean);
-- If Project is a library project, add the correct -L and -l switches to
-- the linker invocation.
......@@ -1265,10 +1264,9 @@ procedure GNATCmd is
procedure Set_Library_For
(Project : Project_Id;
Tree : Project_Tree_Ref;
In_Aggregate_Lib : Boolean;
Libraries_Present : in out Boolean)
is
pragma Unreferenced (Tree, In_Aggregate_Lib);
pragma Unreferenced (Tree);
Path_Option : constant String_Access :=
MLib.Linker_Library_Path_Option;
......
gcc/ada/makeutl.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2004-2011, Free Software Foundation, Inc. --
-- Copyright (C) 2004-2012, 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- --
......@@ -692,10 +692,9 @@ package body Makeutl is
is
procedure Recursive_Add
(Project : Project_Id;
Tree : Project_Tree_Ref;
In_Aggregate_Lib : Boolean;
Extended : in out Boolean);
(Project : Project_Id;
Tree : Project_Tree_Ref;
Extended : in out Boolean);
-- Add all the source directories of a project to the path only if
-- this project has not been visited. Calls itself recursively for
-- projects being extended, and imported projects.
......@@ -732,13 +731,10 @@ package body Makeutl is
-------------------
procedure Recursive_Add
(Project : Project_Id;
Tree : Project_Tree_Ref;
In_Aggregate_Lib : Boolean;
Extended : in out Boolean)
(Project : Project_Id;
Tree : Project_Tree_Ref;
Extended : in out Boolean)
is
pragma Unreferenced (In_Aggregate_Lib);
Current : String_List_Id;
Dir : String_Element;
OK : Boolean := False;
......@@ -1234,10 +1230,9 @@ package body Makeutl is
In_Tree : Project_Tree_Ref) return String_List
is
procedure Recursive_Add
(Proj : Project_Id;
In_Tree : Project_Tree_Ref;
In_Aggregate_Lib : Boolean;
Dummy : in out Boolean);
(Proj : Project_Id;
In_Tree : Project_Tree_Ref;
Dummy : in out Boolean);
-- The recursive routine used to add linker options
-------------------
......@@ -1245,12 +1240,11 @@ package body Makeutl is
-------------------
procedure Recursive_Add
(Proj : Project_Id;
In_Tree : Project_Tree_Ref;
In_Aggregate_Lib : Boolean;
Dummy : in out Boolean)
(Proj : Project_Id;
In_Tree : Project_Tree_Ref;
Dummy : in out Boolean)
is
pragma Unreferenced (Dummy, In_Aggregate_Lib);
pragma Unreferenced (Dummy);
Linker_Package : Package_Id;
Options : Variable_Value;
......
gcc/ada/prj-conf.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2006-2011, Free Software Foundation, Inc. --
-- Copyright (C) 2006-2012, 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- --
......@@ -728,10 +728,9 @@ package body Prj.Conf is
Value_Of (Name_Ide, Project.Decl.Packages, Shared);
procedure Add_Config_Switches_For_Project
(Project : Project_Id;
Tree : Project_Tree_Ref;
In_Aggregate_Lib : Boolean;
With_State : in out Integer);
(Project : Project_Id;
Tree : Project_Tree_Ref;
With_State : in out Integer);
-- Add all --config switches for this project. This is also called
-- for aggregate projects.
......@@ -740,12 +739,11 @@ package body Prj.Conf is
-------------------------------------
procedure Add_Config_Switches_For_Project
(Project : Project_Id;
Tree : Project_Tree_Ref;
In_Aggregate_Lib : Boolean;
With_State : in out Integer)
(Project : Project_Id;
Tree : Project_Tree_Ref;
With_State : in out Integer)
is
pragma Unreferenced (With_State, In_Aggregate_Lib);
pragma Unreferenced (With_State);
Shared : constant Shared_Project_Tree_Data_Access := Tree.Shared;
......
gcc/ada/prj-env.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2011, Free Software Foundation, Inc. --
-- Copyright (C) 2001-2012, 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- --
......@@ -115,10 +115,9 @@ package body Prj.Env is
Buffer_Last : Natural := 0;
procedure Add
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
In_Aggregate_Lib : Boolean;
Dummy : in out Boolean);
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Dummy : in out Boolean);
-- Add source dirs of Project to the path
---------
......@@ -126,12 +125,11 @@ package body Prj.Env is
---------
procedure Add
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
In_Aggregate_Lib : Boolean;
Dummy : in out Boolean)
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Dummy : in out Boolean)
is
pragma Unreferenced (Dummy, In_Aggregate_Lib);
pragma Unreferenced (Dummy);
begin
Add_To_Path
(Project.Source_Dirs, In_Tree.Shared, Buffer, Buffer_Last);
......@@ -187,10 +185,9 @@ package body Prj.Env is
Buffer_Last : Natural := 0;
procedure Add
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
In_Aggregate_Lib : Boolean;
Dummy : in out Boolean);
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Dummy : in out Boolean);
-- Add all the object directories of a project to the path
---------
......@@ -198,12 +195,11 @@ package body Prj.Env is
---------
procedure Add
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
In_Aggregate_Lib : Boolean;
Dummy : in out Boolean)
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Dummy : in out Boolean)
is
pragma Unreferenced (Dummy, In_Tree, In_Aggregate_Lib);
pragma Unreferenced (Dummy, In_Tree);
Path : constant Path_Name_Type :=
Get_Object_Directory
......@@ -476,10 +472,9 @@ package body Prj.Env is
Current_Naming : Naming_Id;
procedure Check
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
In_Aggregate_Lib : Boolean;
State : in out Integer);
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
State : in out Integer);
-- Recursive procedure that put in the config pragmas file any non
-- standard naming schemes, if it is not already in the file, then call
-- itself for any imported project.
......@@ -501,12 +496,11 @@ package body Prj.Env is
-----------
procedure Check
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
In_Aggregate_Lib : Boolean;
State : in out Integer)
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
State : in out Integer)
is
pragma Unreferenced (State, In_Aggregate_Lib);
pragma Unreferenced (State);
Lang : constant Language_Ptr :=
Get_Language_From_Name (Project, "ada");
......@@ -792,10 +786,9 @@ package body Prj.Env is
-- Put the line contained in the Name_Buffer in the global buffer
procedure Process
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
In_Aggregate_Lib : Boolean;
State : in out Integer);
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
State : in out Integer);
-- Generate the mapping file for Project (not recursively)
---------------------
......@@ -818,12 +811,11 @@ package body Prj.Env is
-------------
procedure Process
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
In_Aggregate_Lib : Boolean;
State : in out Integer)
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
State : in out Integer)
is
pragma Unreferenced (State, In_Aggregate_Lib);
pragma Unreferenced (State);
Source : Source_Id;
Suffix : File_Name_Type;
......@@ -1233,10 +1225,9 @@ package body Prj.Env is
Tree : Project_Tree_Ref)
is
procedure For_Project
(Prj : Project_Id;
Tree : Project_Tree_Ref;
In_Aggregate_Lib : Boolean;
Dummy : in out Integer);
(Prj : Project_Id;
Tree : Project_Tree_Ref;
Dummy : in out Integer);
-- Get all object directories of Prj
-----------------
......@@ -1244,12 +1235,11 @@ package body Prj.Env is
-----------------
procedure For_Project
(Prj : Project_Id;
Tree : Project_Tree_Ref;
In_Aggregate_Lib : Boolean;
Dummy : in out Integer)
(Prj : Project_Id;
Tree : Project_Tree_Ref;
Dummy : in out Integer)
is
pragma Unreferenced (Dummy, Tree, In_Aggregate_Lib);
pragma Unreferenced (Dummy, Tree);
begin
-- ??? Set_Ada_Paths has a different behavior for library project
......@@ -1280,10 +1270,9 @@ package body Prj.Env is
In_Tree : Project_Tree_Ref)
is
procedure For_Project
(Prj : Project_Id;
In_Tree : Project_Tree_Ref;
In_Aggregate_Lib : Boolean;
Dummy : in out Integer);
(Prj : Project_Id;
In_Tree : Project_Tree_Ref;
Dummy : in out Integer);
-- Get all object directories of Prj
-----------------
......@@ -1291,12 +1280,11 @@ package body Prj.Env is
-----------------
procedure For_Project
(Prj : Project_Id;
In_Tree : Project_Tree_Ref;
In_Aggregate_Lib : Boolean;
Dummy : in out Integer)
(Prj : Project_Id;
In_Tree : Project_Tree_Ref;
Dummy : in out Integer)
is
pragma Unreferenced (Dummy, In_Aggregate_Lib);
pragma Unreferenced (Dummy);
Current : String_List_Id := Prj.Source_Dirs;
The_String : String_Element;
......@@ -1654,10 +1642,9 @@ package body Prj.Env is
Buffer_Last : Natural := 0;
procedure Recursive_Add
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
In_Aggregate_Lib : Boolean;
Dummy : in out Boolean);
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Dummy : in out Boolean);
-- Recursive procedure to add the source/object paths of extended/
-- imported projects.
......@@ -1666,12 +1653,11 @@ package body Prj.Env is
-------------------
procedure Recursive_Add
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
In_Aggregate_Lib : Boolean;
Dummy : in out Boolean)
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Dummy : in out Boolean)
is
pragma Unreferenced (Dummy, In_Tree, In_Aggregate_Lib);
pragma Unreferenced (Dummy, In_Tree);
Path : Path_Name_Type;
......
gcc/ada/prj-nmsc.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2000-2011, Free Software Foundation, Inc. --
-- Copyright (C) 2000-2012, 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- --
......@@ -8201,10 +8201,10 @@ package body Prj.Nmsc is
-- Process the naming scheme for a single project
procedure Recursive_Check
(Project : Project_Id;
Prj_Tree : Project_Tree_Ref;
In_Aggregate_Lib : Boolean;
Data : in out Tree_Processing_Data);
(Project : Project_Id;
Prj_Tree : Project_Tree_Ref;
Context : Project_Context;
Data : in out Tree_Processing_Data);
-- Check_Naming_Scheme for the project
-----------
......@@ -8345,10 +8345,10 @@ package body Prj.Nmsc is
---------------------
procedure Recursive_Check
(Project : Project_Id;
Prj_Tree : Project_Tree_Ref;
In_Aggregate_Lib : Boolean;
Data : in out Tree_Processing_Data)
(Project : Project_Id;
Prj_Tree : Project_Tree_Ref;
Context : Project_Context;
Data : in out Tree_Processing_Data)
is
begin
if Current_Verbosity = High then
......@@ -8357,17 +8357,17 @@ package body Prj.Nmsc is
end if;
Data.Tree := Prj_Tree;
Data.In_Aggregate_Lib := In_Aggregate_Lib;
Data.In_Aggregate_Lib := Context.In_Aggregate_Lib;
Check (Project, In_Aggregate_Lib, Data);
Check (Project, Context.In_Aggregate_Lib, Data);
if Current_Verbosity = High then
Debug_Decrease_Indent ("done Processing_Naming_Scheme");
end if;
end Recursive_Check;
procedure Check_All_Projects is new
For_Every_Project_Imported (Tree_Processing_Data, Recursive_Check);
procedure Check_All_Projects is new For_Every_Project_Imported_Context
(Tree_Processing_Data, Recursive_Check);
Data : Tree_Processing_Data;
......
gcc/ada/prj.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2001-2011, Free Software Foundation, Inc. --
-- Copyright (C) 2001-2012, 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- --
......@@ -1562,10 +1562,9 @@ package Prj is
generic
type State is limited private;
with procedure Action
(Project : Project_Id;
Tree : Project_Tree_Ref;
In_Aggregate_Lib : Boolean;
With_State : in out State);
(Project : Project_Id;
Tree : Project_Tree_Ref;
With_State : in out State);
procedure For_Every_Project_Imported
(By : Project_Id;
Tree : Project_Tree_Ref;
......@@ -1597,6 +1596,27 @@ package Prj is
-- The Tree argument passed to the callback is required in the case of
-- aggregated projects, since they might not be using the same tree as 'By'
type Project_Context is record
In_Aggregate_Lib : Boolean;
-- True if the project is part of an aggregate library
From_Encapsulated_Lib : Boolean;
-- True if the project is imported from an encapsulated library
end record;
generic
type State is limited private;
with procedure Action
(Project : Project_Id;
Tree : Project_Tree_Ref;
Context : Project_Context;
With_State : in out State);
procedure For_Every_Project_Imported_Context
(By : Project_Id;
Tree : Project_Tree_Ref;
With_State : in out State;
Include_Aggregated : Boolean := True;
Imported_First : Boolean := False);
function Extend_Name
(File : File_Name_Type;
With_Suffix : String) return File_Name_Type;
......
gcc/ada/s-diflio.ads
......@@ -53,7 +53,7 @@ package System.Dim_Float_IO is
Fore : Field := Default_Fore;
Aft : Field := Default_Aft;
Exp : Field := Default_Exp;
Symbols : String := "");
Symbols : String := "");
procedure Put
(Item : Num_Dim_Float;
......
gcc/ada/sem_dim.adb
......@@ -2331,19 +2331,21 @@ package body Sem_Dim is
Actual := First (Actuals);
while Present (Actual) loop
-- Copy every comes from source actuals in New_Actuals
if Comes_From_Source (Actual) then
if Nkind (Actual) = N_Parameter_Association then
Append (
Make_Parameter_Association (Loc,
Selector_Name => New_Copy (Selector_Name (Actual)),
Explicit_Actual_Parameter =>
New_Copy (Explicit_Actual_Parameter (Actual))),
New_Actuals);
else
Append (New_Copy (Actual), New_Actuals);
end if;
-- Copy every actuals in New_Actuals except the Symbols
-- parameter association.
if Nkind (Actual) = N_Parameter_Association
and then Chars (Selector_Name (Actual)) /= Name_Symbols
then
Append (
Make_Parameter_Association (Loc,
Selector_Name => New_Copy (Selector_Name (Actual)),
Explicit_Actual_Parameter =>
New_Copy (Explicit_Actual_Parameter (Actual))),
New_Actuals);
elsif Nkind (Actual) /= N_Parameter_Association then
Append (New_Copy (Actual), New_Actuals);
end if;
Next (Actual);
......
gcc/ada/system-vxworks-ppc.ads
......@@ -5,9 +5,9 @@
-- S Y S T E M --
-- --
-- S p e c --
-- (VxWorks 5 and MILS Version PPC) --
-- (VxWorks 5 Version PPC) --
-- --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
......@@ -115,6 +115,9 @@ package System is
private
pragma Linker_Options ("-crtbe");
-- Required by ZCX on VxWorks kernel
type Address is mod Memory_Size;
Null_Address : constant Address := 0;
......
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