Skip to content

R
riscv-gcc-1
Commit 30ebb114 by Arnaud Charlet
Options

[multiple changes] 

2012-10-29  Robert Dewar  <dewar@adacore.com>

	* sem_ch5.adb (Analyze_Loop_Statement): Add warning for identical
	inner/outer ranges.

2012-10-29  Robert Dewar  <dewar@adacore.com>

	* einfo.ads: Change terminology "present" to "defined" in talking
	about whether a given field is defined for a given entity kind.

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

	* atree.ads: Minor comment fix.

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

	* sem_ch13.adb (Replace_Type_Reference): Set_Comes_From_Source.
	Otherwise, the node is ignored by ASIS.
	* sem_ch5.adb: Minor reformatting.

2012-10-29  Thomas Quinot  <quinot@adacore.com>

	* exp_attr.adb, exp_dist.adb, exp_dist.ads (Build_To_Any_Call): Pass
	an explicit Loc parameter to set the source location of generated
	nodes.

2012-10-29  Tristan Gingold  <gingold@adacore.com>

	* exp_ch9.adb (Build_Task_Activation_Call): Do nothing on
	restricted profile.
	* bindgen.adb (System_Tasking_Restricted_Stages_Used): New variable.
	(Gen_Adainit): Declare and call Activate_Tasks when the above variable
	is set.
	(Resolve_Binder_Options): Set the variable.
	* rtsfind.ads (RE_Activate_Restricted_Tasks): Removed (now unused).
	* s-tarest.adb (Tasks_Activation_Chain): New variable.
	(Activate_Restricted_Tasks): Removed, and replaced by ...
	(Activate_Tasks): New procedure, to activate all tasks at
	the end of elaboration.
	(Create_Restricted_Tasks): Chain parameter is now unreferenced.	Put
	the created task on the Tasks_Activation_Chain list.
	* s-tarest.ads (Activate_Restricted_Tasks): Removed.
	(Activate_Tasks): Added.

2012-10-29  Gary Dismukes  <dismukes@adacore.com>

	* sem_res.adb (Resolve_If_Expression): Compare subtype of the 'then'
	expression against the subtype of the expression rather than comparing
	base types, same as is already done for the 'else' expression.

From-SVN: r192918
parent 2a8fcd43
Showing with 217 additions and 77 deletions
gcc/ada/ChangeLog
2012-10-29 Robert Dewar <dewar@adacore.com>
* sem_ch5.adb (Analyze_Loop_Statement): Add warning for identical
inner/outer ranges.
2012-10-29 Robert Dewar <dewar@adacore.com>
* einfo.ads: Change terminology "present" to "defined" in talking
about whether a given field is defined for a given entity kind.
2012-10-29 Bob Duff <duff@adacore.com>
* atree.ads: Minor comment fix.
2012-10-29 Bob Duff <duff@adacore.com>
* sem_ch13.adb (Replace_Type_Reference): Set_Comes_From_Source.
Otherwise, the node is ignored by ASIS.
* sem_ch5.adb: Minor reformatting.
2012-10-29 Thomas Quinot <quinot@adacore.com>
* exp_attr.adb, exp_dist.adb, exp_dist.ads (Build_To_Any_Call): Pass
an explicit Loc parameter to set the source location of generated
nodes.
2012-10-29 Tristan Gingold <gingold@adacore.com>
* exp_ch9.adb (Build_Task_Activation_Call): Do nothing on
restricted profile.
* bindgen.adb (System_Tasking_Restricted_Stages_Used): New variable.
(Gen_Adainit): Declare and call Activate_Tasks when the above variable
is set.
(Resolve_Binder_Options): Set the variable.
* rtsfind.ads (RE_Activate_Restricted_Tasks): Removed (now unused).
* s-tarest.adb (Tasks_Activation_Chain): New variable.
(Activate_Restricted_Tasks): Removed, and replaced by ...
(Activate_Tasks): New procedure, to activate all tasks at
the end of elaboration.
(Create_Restricted_Tasks): Chain parameter is now unreferenced. Put
the created task on the Tasks_Activation_Chain list.
* s-tarest.ads (Activate_Restricted_Tasks): Removed.
(Activate_Tasks): Added.
2012-10-29 Gary Dismukes <dismukes@adacore.com>
* sem_res.adb (Resolve_If_Expression): Compare subtype of the 'then'
expression against the subtype of the expression rather than comparing
base types, same as is already done for the 'else' expression.
2012-10-29 Steve Baird <baird@adacore.com>
* sem_ch13.adb (Analyze_Attribute_Definition_Clause): If CodePeer_Mode
......
gcc/ada/atree.ads
......@@ -767,7 +767,7 @@ package Atree is
-- Note that this routine is very rarely used, since usually the
-- default mechanism provided sets the right value, but in some
-- unusual cases, the value needs to be reset (e.g. when a source
-- node is copied, and the copy must not have Comes_From_Source set.
-- node is copied, and the copy must not have Comes_From_Source set).
procedure Set_Has_Aspects (N : Node_Id; Val : Boolean := True);
pragma Inline (Set_Has_Aspects);
......
gcc/ada/bindgen.adb
......@@ -78,6 +78,12 @@ package body Bindgen is
-- disallow the creation of new dispatching domains just before calling
-- the main procedure from the environment task.
System_Tasking_Restricted_Stages_Used : Boolean := False;
-- Flag indicating whether the unit System.Tasking.Restricted.Stages is in
-- the closure of the partition. This is set by Resolve_Binder_Options,
-- and it used to call a routine to active all the tasks at the end of
-- the elaboration.
Lib_Final_Built : Boolean := False;
-- Flag indicating whether the finalize_library rountine has been built
......@@ -534,6 +540,12 @@ package body Bindgen is
WBI ("");
end if;
if System_Tasking_Restricted_Stages_Used then
WBI (" procedure Activate_Tasks;");
WBI (" pragma Import (C, Activate_Tasks," &
" ""__gnat_activate_tasks"");");
end if;
WBI (" begin");
if Main_Priority /= No_Main_Priority then
......@@ -625,6 +637,14 @@ package body Bindgen is
WBI (" pragma Import (C, Handler_Installed, " &
"""__gnat_handler_installed"");");
-- Import task activation procedure for ravenscar
if System_Tasking_Restricted_Stages_Used then
WBI (" procedure Activate_Tasks;");
WBI (" pragma Import (C, Activate_Tasks," &
" ""__gnat_activate_tasks"");");
end if;
-- The import of the soft link which performs library-level object
-- finalization is not needed for VM targets; regular Ada is used in
-- that case. For restricted run-time libraries (ZFP and Ravenscar)
......@@ -945,6 +965,10 @@ package body Bindgen is
WBI (" Freeze_Dispatching_Domains;");
end if;
if System_Tasking_Restricted_Stages_Used then
WBI (" Activate_Tasks;");
end if;
-- Case of main program is CIL function or procedure
if VM_Target = CLI_Target
......@@ -2863,6 +2887,12 @@ package body Bindgen is
if OpenVMS_On_Target and then Name_Buffer (1 .. 5) = "dec%s" then
With_DECGNAT := True;
end if;
-- Likewise for the use of restricted tasking
if Name_Buffer (1 .. 34) = "system.tasking.restricted.stages%s" then
System_Tasking_Restricted_Stages_Used := True;
end if;
end loop;
end Resolve_Binder_Options;
......
gcc/ada/einfo.ads
This source diff could not be displayed because it is too large. You can view the blob instead.
gcc/ada/exp_attr.adb
......@@ -5141,7 +5141,8 @@ package body Exp_Attr is
begin
Rewrite (N,
Build_To_Any_Call
(Convert_To (P_Type,
(Loc,
Convert_To (P_Type,
Relocate_Node (First (Exprs))), Decls));
Insert_Actions (N, Decls);
Analyze_And_Resolve (N, RTE (RE_Any));
......
gcc/ada/exp_ch9.adb
......@@ -4817,6 +4817,13 @@ package body Exp_Ch9 is
P : Node_Id;
begin
-- On restricted profile, all the tasks will be activated at the end
-- of the elaboration (Sequential elaboration policy).
if Restricted_Profile then
return;
end if;
-- Get the activation chain entity. Except in the case of a package
-- body, this is in the node that was passed. For a package body, we
-- have to find the corresponding package declaration node.
......@@ -4835,11 +4842,7 @@ package body Exp_Ch9 is
end if;
if Present (Chain) then
if Restricted_Profile then
Name := New_Reference_To (RTE (RE_Activate_Restricted_Tasks), Loc);
else
Name := New_Reference_To (RTE (RE_Activate_Tasks), Loc);
end if;
Name := New_Reference_To (RTE (RE_Activate_Tasks), Loc);
Call :=
Make_Procedure_Call_Statement (Loc,
......
gcc/ada/exp_dist.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- Copyright (C) 1992-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- --
......@@ -144,13 +144,14 @@ package Exp_Dist is
-- declaration is appended to Decls.
function Build_To_Any_Call
(N : Node_Id;
(Loc : Source_Ptr;
N : Node_Id;
Decls : List_Id) return Node_Id;
-- Build call to To_Any attribute function with expression as actual
-- parameter. Decls is the declarations list for an appropriate
-- enclosing scope of the point where the call will be inserted; if
-- the To_Any attribute for Typ needs to be generated at this point,
-- its declaration is appended to Decls.
-- parameter. Loc is the reference location for generated nodes, Decls is
-- the declarations list for an appropriate enclosing scope of the point
-- where the call will be inserted; if the To_Any attribute for Typ needs
-- to be generated at this point, its declaration is appended to Decls.
function Build_TypeCode_Call
(Loc : Source_Ptr;
......
gcc/ada/rtsfind.ads
......@@ -1756,7 +1756,6 @@ package Rtsfind is
RE_Timed_Task_Entry_Call, -- System.Tasking.Rendezvous
RE_Timed_Selective_Wait, -- System.Tasking.Rendezvous
RE_Activate_Restricted_Tasks, -- System.Tasking.Restricted.Stages
RE_Complete_Restricted_Activation, -- System.Tasking.Restricted.Stages
RE_Create_Restricted_Task, -- System.Tasking.Restricted.Stages
RE_Complete_Restricted_Task, -- System.Tasking.Restricted.Stages
......@@ -3042,7 +3041,6 @@ package Rtsfind is
RE_Timed_Task_Entry_Call => System_Tasking_Rendezvous,
RE_Timed_Selective_Wait => System_Tasking_Rendezvous,
RE_Activate_Restricted_Tasks => System_Tasking_Restricted_Stages,
RE_Complete_Restricted_Activation => System_Tasking_Restricted_Stages,
RE_Create_Restricted_Task => System_Tasking_Restricted_Stages,
RE_Complete_Restricted_Task => System_Tasking_Restricted_Stages,
......
gcc/ada/s-tarest.adb
......@@ -70,6 +70,9 @@ package body System.Tasking.Restricted.Stages is
use Task_Primitives.Operations;
use Task_Info;
Tasks_Activation_Chain : Task_Id;
-- Chain of all the tasks to activate
Global_Task_Lock : aliased System.Task_Primitives.RTS_Lock;
-- This is a global lock; it is used to execute in mutual exclusion
-- from all other tasks. It is only used by Task_Lock and Task_Unlock.
......@@ -298,9 +301,9 @@ package body System.Tasking.Restricted.Stages is
-- Restricted GNARLI --
-----------------------
-------------------------------
-- Activate_Restricted_Tasks --
-------------------------------
--------------------
-- Activate_Tasks --
--------------------
-- Note that locks of activator and activated task are both locked here.
-- This is necessary because C.State and Self.Wait_Count have to be
......@@ -308,9 +311,7 @@ package body System.Tasking.Restricted.Stages is
-- created before the activated task. That satisfies our
-- in-order-of-creation ATCB locking policy.
procedure Activate_Restricted_Tasks
(Chain_Access : Activation_Chain_Access)
is
procedure Activate_Tasks is
Self_ID : constant Task_Id := STPO.Self;
C : Task_Id;
Activate_Prio : System.Any_Priority;
......@@ -332,8 +333,7 @@ package body System.Tasking.Restricted.Stages is
-- Activate all the tasks in the chain. Creation of the thread of
-- control was deferred until activation. So create it now.
C := Chain_Access.T_ID;
C := Tasks_Activation_Chain;
while C /= null loop
if C.Common.State /= Terminated then
pragma Assert (C.Common.State = Unactivated);
......@@ -384,8 +384,8 @@ package body System.Tasking.Restricted.Stages is
-- Remove the tasks from the chain
Chain_Access.T_ID := null;
end Activate_Restricted_Tasks;
Tasks_Activation_Chain := null;
end Activate_Tasks;
------------------------------------
-- Complete_Restricted_Activation --
......@@ -466,6 +466,8 @@ package body System.Tasking.Restricted.Stages is
Task_Image : String;
Created_Task : Task_Id)
is
pragma Unreferenced (Chain);
Self_ID : constant Task_Id := STPO.Self;
Base_Priority : System.Any_Priority;
Base_CPU : System.Multiprocessors.CPU_Range;
......@@ -558,8 +560,8 @@ package body System.Tasking.Restricted.Stages is
-- may be used by the operation of Ada code within the task.
SSL.Create_TSD (Created_Task.Common.Compiler_Data);
Created_Task.Common.Activation_Link := Chain.T_ID;
Chain.T_ID := Created_Task;
Created_Task.Common.Activation_Link := Tasks_Activation_Chain;
Tasks_Activation_Chain := Created_Task;
end Create_Restricted_Task;
---------------------------
......
gcc/ada/s-tarest.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
......@@ -175,20 +175,11 @@ package System.Tasking.Restricted.Stages is
--
-- This procedure can raise Storage_Error if the task creation fails
procedure Activate_Restricted_Tasks
(Chain_Access : Activation_Chain_Access);
-- Compiler interface only. Do not call from within the RTS.
-- This must be called by the creator of a chain of one or more new tasks,
-- to activate them. The chain is a linked list that up to this point is
-- only known to the task that created them, though the individual tasks
-- are already in the All_Tasks_List.
--
-- The compiler builds the chain in LIFO order (as a stack). Another
-- version of this procedure had code to reverse the chain, so as to
-- activate the tasks in the order of declaration. This might be nice, but
-- it is not needed if priority-based scheduling is supported, since all
-- the activated tasks synchronize on the activators lock before they start
-- activating and so they should start activating in priority order.
procedure Activate_Tasks;
pragma Export (C, Activate_Tasks, "__gnat_activate_tasks");
-- Binder interface only. Do not call from within the RTS. This must be
-- called an the end of the elaboration to activate all tasks, in order
-- to implement the sequential elaboration policy.
procedure Complete_Restricted_Activation;
-- Compiler interface only. Do not call from within the RTS. This should be
......@@ -217,7 +208,7 @@ package System.Tasking.Restricted.Stages is
-- restricted_terminated (t1._task_id)
procedure Finalize_Global_Tasks;
-- This is needed to support the compiler interface; it will only be called
-- This is needed to support the compiler interface. It will only be called
-- by the Environment task in the binder generated file (by adafinal).
-- Instead, it will cause the Environment to block forever, since none of
-- the dependent tasks are expected to terminate
......
gcc/ada/sem_ch13.adb
......@@ -5032,7 +5032,8 @@ package body Sem_Ch13 is
----------------------------
procedure Replace_Type_Reference (N : Node_Id) is
-- Use the Sloc of the usage name below, not the defining name
-- See comments in Add_Predicates.Replace_Type_Reference regarding
-- Sloc and Comes_From_Source.
begin
-- Invariant'Class, replace with T'Class (obj)
......@@ -5055,6 +5056,8 @@ package body Sem_Ch13 is
Set_Entity (N, Object_Entity);
Set_Etype (N, Typ);
end if;
Set_Comes_From_Source (N, True);
end Replace_Type_Reference;
-- Start of processing for Add_Invariants
......@@ -5442,6 +5445,11 @@ package body Sem_Ch13 is
Set_Entity (N, Object_Entity);
Set_Etype (N, Typ);
-- We want to treat the node as if it comes from source, so that
-- ASIS will not ignore it
Set_Comes_From_Source (N, True);
end Replace_Type_Reference;
-- Start of processing for Add_Predicates
......
gcc/ada/sem_ch5.adb
......@@ -2626,6 +2626,56 @@ package body Sem_Ch5 is
Push_Scope (Ent);
Analyze_Iteration_Scheme (Iter);
-- Check for following case which merits a warning if the type E of is
-- a multi-dimensional array (and no explicit subscript ranges present).
-- for J in E'Range
-- for K in E'Range
if Present (Iter)
and then Present (Loop_Parameter_Specification (Iter))
then
declare
LPS : constant Node_Id := Loop_Parameter_Specification (Iter);
DSD : constant Node_Id :=
Original_Node (Discrete_Subtype_Definition (LPS));
begin
if Nkind (DSD) = N_Attribute_Reference
and then Attribute_Name (DSD) = Name_Range
and then No (Expressions (DSD))
then
declare
Typ : constant Entity_Id := Etype (Prefix (DSD));
begin
if Is_Array_Type (Typ)
and then Number_Dimensions (Typ) > 1
and then Nkind (Parent (N)) = N_Loop_Statement
and then Present (Iteration_Scheme (Parent (N)))
then
declare
OIter : constant Node_Id :=
Iteration_Scheme (Parent (N));
OLPS : constant Node_Id :=
Loop_Parameter_Specification (OIter);
ODSD : constant Node_Id :=
Original_Node (Discrete_Subtype_Definition (OLPS));
begin
if Nkind (ODSD) = N_Attribute_Reference
and then Attribute_Name (ODSD) = Name_Range
and then No (Expressions (ODSD))
and then Etype (Prefix (ODSD)) = Typ
then
Error_Msg_Sloc := Sloc (ODSD);
Error_Msg_N
("inner range same as outer range#?", DSD);
end if;
end;
end if;
end;
end if;
end;
end if;
-- Analyze the statements of the body except in the case of an Ada 2012
-- iterator with the expander active. In this case the expander will do
-- a rewrite of the loop into a while loop. We will then analyze the
......
gcc/ada/sem_res.adb
......@@ -7155,12 +7155,13 @@ package body Sem_Res is
Resolve (Then_Expr, Typ);
Then_Typ := Etype (Then_Expr);
-- When the "then" expression is of a scalar type different from the
-- result type, then insert a conversion to ensure the generation of
-- a constraint check.
-- When the "then" expression is of a scalar subtype different from the
-- result subtype, then insert a conversion to ensure the generation of
-- a constraint check. The same is done for the else part below, again
-- comparing subtypes rather than base types.
if Is_Scalar_Type (Then_Typ)
and then Base_Type (Then_Typ) /= Base_Type (Typ)
and then Then_Typ /= Typ
then
Rewrite (Then_Expr, Convert_To (Typ, Then_Expr));
Analyze_And_Resolve (Then_Expr, Typ);
......
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