Commit 0789ef6f by Arnaud Charlet

[multiple changes]

2017-01-06  Bob Duff  <duff@adacore.com>

	* sinfo.ads, sinfo.adb (Map_Pragma_Name): Preparation work,
	dummy implementation of Map_Pragma_Name.

2017-01-06  Tristan Gingold  <gingold@adacore.com>

	* 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
parent ffa168bc
2017-01-06 Bob Duff <duff@adacore.com>
* sinfo.ads, sinfo.adb (Map_Pragma_Name): Preparation work,
dummy implementation of Map_Pragma_Name.
2017-01-06 Tristan Gingold <gingold@adacore.com>
* 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 <dismukes@adacore.com>
* einfo.ads, sem_res.adb, sem_attr.adb, sem_ch6.adb: Minor
......
......@@ -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,
......
......@@ -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
......
......@@ -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;
......
......@@ -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;
......
......@@ -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 --
------------------------
......
......@@ -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.
......
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