155682Smarkm------------------------------------------------------------------------------ 2178828Sdfr-- -- 355682Smarkm-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS -- 455682Smarkm-- -- 555682Smarkm-- S Y S T E M . T A S K I N G . P R O T E C T E D _ O B J E C T S -- 655682Smarkm-- -- 755682Smarkm-- S p e c -- 855682Smarkm-- -- 955682Smarkm-- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- 1055682Smarkm-- -- 1155682Smarkm-- GNARL is free software; you can redistribute it and/or modify it under -- 1255682Smarkm-- terms of the GNU General Public License as published by the Free Soft- -- 1355682Smarkm-- ware Foundation; either version 3, or (at your option) any later ver- -- 1455682Smarkm-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 1555682Smarkm-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- 1655682Smarkm-- or FITNESS FOR A PARTICULAR PURPOSE. -- 1755682Smarkm-- -- 1855682Smarkm-- As a special exception under Section 7 of GPL version 3, you are granted -- 1955682Smarkm-- additional permissions described in the GCC Runtime Library Exception, -- 2055682Smarkm-- version 3.1, as published by the Free Software Foundation. -- 2155682Smarkm-- -- 2255682Smarkm-- You should have received a copy of the GNU General Public License and -- 2355682Smarkm-- a copy of the GCC Runtime Library Exception along with this program; -- 2455682Smarkm-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 2555682Smarkm-- <http://www.gnu.org/licenses/>. -- 2655682Smarkm-- -- 2755682Smarkm-- GNARL was developed by the GNARL team at Florida State University. -- 2855682Smarkm-- Extensive contributions were provided by Ada Core Technologies, Inc. -- 2955682Smarkm-- -- 3055682Smarkm------------------------------------------------------------------------------ 3155682Smarkm 3255682Smarkm-- This package provides necessary definitions to handle simple (i.e without 3355682Smarkm-- entries) protected objects. 34178828Sdfr 3557428Smarkm-- All the routines that handle protected objects with entries have been moved 3655682Smarkm-- to two children: Entries and Operations. Note that Entries only contains 3755682Smarkm-- the type declaration and the OO primitives. This is needed to avoid 3855682Smarkm-- circular dependency. 3955682Smarkm 4055682Smarkm-- This package is part of the high level tasking interface used by the 4155682Smarkm-- compiler to expand Ada 95 tasking constructs into simpler run time calls 4255682Smarkm-- (aka GNARLI, GNU Ada Run-time Library Interface) 4355682Smarkm 4455682Smarkm-- Note: the compiler generates direct calls to this interface, via Rtsfind. 4555682Smarkm-- Any changes to this interface may require corresponding compiler changes 4655682Smarkm-- in exp_ch9.adb and possibly exp_ch7.adb and exp_attr.adb 4755682Smarkm 4855682Smarkmpackage System.Tasking.Protected_Objects is 49103426Snectar pragma Elaborate_Body; 5055682Smarkm 5155682Smarkm --------------------------------- 5255682Smarkm -- Compiler Interface (GNARLI) -- 5355682Smarkm --------------------------------- 54178828Sdfr 55178828Sdfr -- The compiler will expand in the GNAT tree the following construct: 56178828Sdfr 5755682Smarkm -- protected PO is 5855682Smarkm -- procedure P; 5955682Smarkm -- private 6055682Smarkm -- open : boolean := false; 6155682Smarkm -- end PO; 6255682Smarkm 6355682Smarkm -- protected body PO is 6455682Smarkm -- procedure P is 6555682Smarkm -- ...variable declarations... 6655682Smarkm -- begin 6755682Smarkm -- ...B... 68178828Sdfr -- end P; 69178828Sdfr -- end PO; 70178828Sdfr 7155682Smarkm -- as follows: 7255682Smarkm 7355682Smarkm -- protected type poT is 7455682Smarkm -- procedure p; 7555682Smarkm -- private 7655682Smarkm -- open : boolean := false; 7755682Smarkm -- end poT; 7855682Smarkm -- type poTV is limited record 7955682Smarkm -- open : boolean := false; 8055682Smarkm -- _object : aliased protection; 8155682Smarkm -- end record; 8255682Smarkm -- procedure poPT__pN (_object : in out poTV); 8355682Smarkm -- procedure poPT__pP (_object : in out poTV); 8455682Smarkm -- freeze poTV [ 8555682Smarkm -- procedure poTVI (_init : in out poTV) is 8655682Smarkm -- begin 8755682Smarkm -- _init.open := false; 8855682Smarkm -- object-init-proc (_init._object); 8955682Smarkm -- initialize_protection (_init._object'unchecked_access, 9055682Smarkm -- unspecified_priority); 9155682Smarkm -- return; 9255682Smarkm -- end _init_proc; 9355682Smarkm -- ] 9455682Smarkm -- po : poT; 9555682Smarkm -- poTVI (poTV!(po)); 9655682Smarkm 9755682Smarkm -- procedure poPT__pN (_object : in out poTV) is 9855682Smarkm -- poR : protection renames _object._object; 9955682Smarkm -- openP : boolean renames _object.open; 10055682Smarkm -- ...variable declarations... 10155682Smarkm -- begin 10255682Smarkm -- ...B... 10355682Smarkm -- return; 10455682Smarkm -- end poPT__pN; 10555682Smarkm 10655682Smarkm -- procedure poPT__pP (_object : in out poTV) is 10755682Smarkm -- procedure _clean is 10855682Smarkm -- begin 10955682Smarkm -- unlock (_object._object'unchecked_access); 11055682Smarkm -- return; 11155682Smarkm -- end _clean; 11255682Smarkm -- begin 11355682Smarkm -- lock (_object._object'unchecked_access); 11455682Smarkm -- B2b : begin 11555682Smarkm -- poPT__pN (_object); 116102647Snectar -- at end 117102647Snectar -- _clean; 118102647Snectar -- end B2b; 119178828Sdfr -- return; 120178828Sdfr -- end poPT__pP; 121178828Sdfr 122178828Sdfr Null_Protected_Entry : constant := Null_Entry; 123178828Sdfr 124178828Sdfr Max_Protected_Entry : constant := Max_Entry; 125178828Sdfr 126178828Sdfr type Protected_Entry_Index is new Entry_Index 127178828Sdfr range Null_Protected_Entry .. Max_Protected_Entry; 128178828Sdfr 129178828Sdfr type Barrier_Function_Pointer is access 130178828Sdfr function 13155682Smarkm (O : System.Address; 13255682Smarkm E : Protected_Entry_Index) 13355682Smarkm return Boolean; 13455682Smarkm -- Pointer to a function which evaluates the barrier of a protected 135103426Snectar -- entry body. O is a pointer to the compiler-generated record 13655682Smarkm -- representing the protected object, and E is the index of the 137178828Sdfr -- entry serviced by the body. 13878536Sassar 139178828Sdfr type Entry_Action_Pointer is access 140178828Sdfr procedure 141178828Sdfr (O : System.Address; 142178828Sdfr P : System.Address; 143178828Sdfr E : Protected_Entry_Index); 144178828Sdfr -- Pointer to a procedure which executes the sequence of statements 145178828Sdfr -- of a protected entry body. O is a pointer to the compiler-generated 146178828Sdfr -- record representing the protected object, P is a pointer to the 147178828Sdfr -- record of entry parameters, and E is the index of the 148178828Sdfr -- entry serviced by the body. 149178828Sdfr 150178828Sdfr type Entry_Body is record 151178828Sdfr Barrier : Barrier_Function_Pointer; 15255682Smarkm Action : Entry_Action_Pointer; 15355682Smarkm end record; 15455682Smarkm -- The compiler-generated code passes objects of this type to the GNARL 15555682Smarkm -- to allow it to access the executable code of an entry body. 15655682Smarkm 157178828Sdfr type Entry_Body_Access is access all Entry_Body; 158178828Sdfr 159178828Sdfr type Protection is limited private; 16055682Smarkm -- This type contains the GNARL state of a protected object. The 16155682Smarkm -- application-defined portion of the state (i.e. private objects) 162178828Sdfr -- is maintained by the compiler-generated code. 163178828Sdfr -- Note that there are now 2 Protection types. One for the simple 16455682Smarkm -- case (no entries) and one for the general case that needs the whole 16555682Smarkm -- Finalization mechanism. 16655682Smarkm -- This split helps in the case of restricted run time where we want to 16755682Smarkm -- minimize the size of the code. 168102647Snectar 169102647Snectar type Protection_Access is access all Protection; 17055682Smarkm 171178828Sdfr Null_PO : constant Protection_Access := null; 172178828Sdfr 17355682Smarkm function Get_Ceiling 17455682Smarkm (Object : Protection_Access) return System.Any_Priority; 17555682Smarkm -- Returns the new ceiling priority of the protected object 17655682Smarkm 177178828Sdfr procedure Initialize_Protection 178178828Sdfr (Object : Protection_Access; 179178828Sdfr Ceiling_Priority : Integer); 180178828Sdfr -- Initialize the Object parameter so that it can be used by the runtime 181178828Sdfr -- to keep track of the runtime state of a protected object. 182178828Sdfr 183178828Sdfr procedure Lock (Object : Protection_Access); 184178828Sdfr -- Lock a protected object for write access. Upon return, the caller 185178828Sdfr -- owns the lock to this object, and no other call to Lock or 186178828Sdfr -- Lock_Read_Only with the same argument will return until the 187178828Sdfr -- corresponding call to Unlock has been made by the caller. 188178828Sdfr 189178828Sdfr procedure Lock_Read_Only (Object : Protection_Access); 190178828Sdfr -- Lock a protected object for read access. Upon return, the caller 191178828Sdfr -- owns the lock for read access, and no other calls to Lock with the 192178828Sdfr -- same argument will return until the corresponding call to Unlock 193178828Sdfr -- has been made by the caller. Other calls to Lock_Read_Only may (but 194178828Sdfr -- need not) return before the call to Unlock, and the corresponding 195178828Sdfr -- callers will also own the lock for read access. 196178828Sdfr 197178828Sdfr procedure Set_Ceiling 198178828Sdfr (Object : Protection_Access; 199178828Sdfr Prio : System.Any_Priority); 200178828Sdfr -- Sets the new ceiling priority of the protected object 201178828Sdfr 202178828Sdfr procedure Unlock (Object : Protection_Access); 203178828Sdfr -- Relinquish ownership of the lock for the object represented by 204178828Sdfr -- the Object parameter. If this ownership was for write access, or 205178828Sdfr -- if it was for read access where there are no other read access 206178828Sdfr -- locks outstanding, one (or more, in the case of Lock_Read_Only) 207178828Sdfr -- of the tasks waiting on this lock (if any) will be given the 208178828Sdfr -- lock and allowed to return from the Lock or Lock_Read_Only call. 209178828Sdfr 210178828Sdfrprivate 211178828Sdfr type Protection is record 212178828Sdfr L : aliased Task_Primitives.Lock; 213178828Sdfr -- Lock used to ensure mutual exclusive access to the protected object 214178828Sdfr 215178828Sdfr Ceiling : System.Any_Priority; 216178828Sdfr -- Ceiling priority associated to the protected object 217178828Sdfr 218178828Sdfr New_Ceiling : System.Any_Priority; 219178828Sdfr -- New ceiling priority associated to the protected object. In case 220178828Sdfr -- of assignment of a new ceiling priority to the protected object the 221178828Sdfr -- frontend generates a call to set_ceiling to save the new value in 222178828Sdfr -- this field. After such assignment this value can be read by means 223178828Sdfr -- of the 'Priority attribute, which generates a call to get_ceiling. 224178828Sdfr -- However, the ceiling of the protected object will not be changed 225178828Sdfr -- until completion of the protected action in which the assignment 226178828Sdfr -- has been executed (AARM D.5.2 (10/2)). 227178828Sdfr 228178828Sdfr Owner : Task_Id; 229178828Sdfr -- This field contains the protected object's owner. Null_Task 230178828Sdfr -- indicates that the protected object is not currently being used. 231178828Sdfr -- This information is used for detecting the type of potentially 232178828Sdfr -- blocking operations described in the ARM 9.5.1, par. 15 (external 233178828Sdfr -- calls on a protected subprogram with the same target object as that 234178828Sdfr -- of the protected action). 235178828Sdfr end record; 236178828Sdfr 237178828Sdfr procedure Finalize_Protection (Object : in out Protection); 238178828Sdfr -- Clean up a Protection object (in particular, finalize the associated 239178828Sdfr -- Lock object). The compiler generates calls automatically to this 240178828Sdfr -- procedure 241178828Sdfr 242178828Sdfrend System.Tasking.Protected_Objects; 243178828Sdfr