From 0789ef6f84d73facdf01b056748e7b43abf3ed17 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Fri, 6 Jan 2017 12:42:39 +0100 Subject: [PATCH] [multiple changes] 2017-01-06 Bob Duff * sinfo.ads, sinfo.adb (Map_Pragma_Name): Preparation work, dummy implementation of Map_Pragma_Name. 2017-01-06 Tristan Gingold * exp_ch9.adb (Expand_N_Protected_Type_Declaration): Make the entry_body variable constant. * s-taprob.ads (Entry_Body_Access): Move to s-tposen. * s-tpoben.ads (Protected_Entry_Body_Access): Now access to constant. * s-tposen.ads (Entry_Body_Access): Moved from s-taprob, now access to constant. From-SVN: r244141 --- gcc/ada/ChangeLog | 15 +++++++++++++++ gcc/ada/exp_ch9.adb | 5 +++-- gcc/ada/s-taprob.ads | 7 +++---- gcc/ada/s-tpoben.ads | 6 +++++- gcc/ada/s-tposen.ads | 3 +++ gcc/ada/sinfo.adb | 9 +++++++++ gcc/ada/sinfo.ads | 4 ++++ 7 files changed, 42 insertions(+), 7 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index e465f9fc622..aca2564c763 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,18 @@ +2017-01-06 Bob Duff + + * sinfo.ads, sinfo.adb (Map_Pragma_Name): Preparation work, + dummy implementation of Map_Pragma_Name. + +2017-01-06 Tristan Gingold + + * exp_ch9.adb (Expand_N_Protected_Type_Declaration): Make the + entry_body variable constant. + * s-taprob.ads (Entry_Body_Access): Move to s-tposen. + * s-tpoben.ads (Protected_Entry_Body_Access): Now access + to constant. + * s-tposen.ads (Entry_Body_Access): Moved from s-taprob, + now access to constant. + 2017-01-06 Gary Dismukes * einfo.ads, sem_res.adb, sem_attr.adb, sem_ch6.adb: Minor diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index 18a56aeb463..56e426bbd83 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -9888,7 +9888,8 @@ package body Exp_Ch9 is Defining_Identifier => Body_Id, Aliased_Present => True, Object_Definition => Obj_Def, - Expression => Expr); + Expression => Expr, + Constant_Present => True); -- A pointer to this array will be placed in the corresponding record -- by its initialization procedure so this needs to be analyzed here. @@ -14203,7 +14204,7 @@ package body Exp_Ch9 is -- null if there is no limit for all entries (usual case). if Has_Entry - and then Pkg_Id /= System_Tasking_Protected_Objects_Single_Entry + and then Pkg_Id = System_Tasking_Protected_Objects_Entries then if Present (Entry_Max_Queue_Lengths_Array (Ptyp)) then Append_To (Args, diff --git a/gcc/ada/s-taprob.ads b/gcc/ada/s-taprob.ads index fa2a99fa794..98bc4b2b36d 100644 --- a/gcc/ada/s-taprob.ads +++ b/gcc/ada/s-taprob.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2016, 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- -- @@ -152,9 +152,8 @@ package System.Tasking.Protected_Objects is Action : Entry_Action_Pointer; end record; -- The compiler-generated code passes objects of this type to the GNARL - -- to allow it to access the executable code of an entry body. - - type Entry_Body_Access is access all Entry_Body; + -- to allow it to access the executable code of an entry body and its + -- barrier. type Protection is limited private; -- This type contains the GNARL state of a protected object. The diff --git a/gcc/ada/s-tpoben.ads b/gcc/ada/s-tpoben.ads index 90bfa89f398..6bd09879946 100644 --- a/gcc/ada/s-tpoben.ads +++ b/gcc/ada/s-tpoben.ads @@ -50,18 +50,22 @@ package System.Tasking.Protected_Objects.Entries is subtype Positive_Protected_Entry_Index is Protected_Entry_Index range 1 .. Protected_Entry_Index'Last; + -- Index of the entry (and in some cases of the queue) type Find_Body_Index_Access is access function (O : System.Address; E : Protected_Entry_Index) return Protected_Entry_Index; + -- Convert a queue index to an entry index (an entries family has one entry + -- index for several queue index). type Protected_Entry_Body_Array is array (Positive_Protected_Entry_Index range <>) of Entry_Body; -- Contains executable code for all entry bodies of a protected type - type Protected_Entry_Body_Access is access all Protected_Entry_Body_Array; + type Protected_Entry_Body_Access is + access constant Protected_Entry_Body_Array; type Protected_Entry_Queue_Array is array (Protected_Entry_Index range <>) of Entry_Queue; diff --git a/gcc/ada/s-tposen.ads b/gcc/ada/s-tposen.ads index b4ad29a8570..ea0513a1792 100644 --- a/gcc/ada/s-tposen.ads +++ b/gcc/ada/s-tposen.ads @@ -182,6 +182,9 @@ package System.Tasking.Protected_Objects.Single_Entry is type Protection_Entry_Access is access all Protection_Entry; + type Entry_Body_Access is access constant Entry_Body; + -- Access to barrier and action function of an entry + procedure Initialize_Protection_Entry (Object : Protection_Entry_Access; Ceiling_Priority : Integer; diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb index c4e97a6d5e6..30960b4a1b7 100644 --- a/gcc/ada/sinfo.adb +++ b/gcc/ada/sinfo.adb @@ -6818,6 +6818,15 @@ package body Sinfo is return Chars (Pragma_Identifier (N)); end Pragma_Name; + --------------------- + -- Map_Pragma_Name -- + --------------------- + + procedure Map_Pragma_Name (From, To : Name_Id) is + begin + null; -- not yet implemented + end Map_Pragma_Name; + ------------------------ -- Pragma_Name_Mapped -- ------------------------ diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index 79b56a12ae2..4a01505dee1 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -11010,6 +11010,10 @@ package Sinfo is pragma Inline (Pragma_Name); -- Convenient function to obtain Chars field of Pragma_Identifier + procedure Map_Pragma_Name (From, To : Name_Id); + -- Used in the implementation of pragma Rename_Pragma. Maps pragma name + -- From to pragma name To, we From can be used as a synonym for To. + function Pragma_Name_Mapped (N : Node_Id) return Name_Id; -- ????Work in progress. -- 2.30.2