OSDN Git Service

2005-03-29 Robert Dewar <dewar@adacore.com>
[pf3gnuchains/gcc-fork.git] / gcc / ada / s-tarest.ads
1 ------------------------------------------------------------------------------
2 --                                                                          --
3 --                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
4 --                                                                          --
5 --     S Y S T E M . T A S K I N G . R E S T R I C T E D . S T A G E S      --
6 --                                                                          --
7 --                                  S p e c                                 --
8 --                                                                          --
9 --          Copyright (C) 1992-2004, Free Software Foundation, Inc.         --
10 --                                                                          --
11 -- GNARL is free software; you can  redistribute it  and/or modify it under --
12 -- terms of the  GNU General Public License as published  by the Free Soft- --
13 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
14 -- sion. GNARL is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
17 -- for  more details.  You should have  received  a copy of the GNU General --
18 -- Public License  distributed with GNARL; see file COPYING.  If not, write --
19 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
20 -- MA 02111-1307, USA.                                                      --
21 --                                                                          --
22 -- As a special exception,  if other files  instantiate  generics from this --
23 -- unit, or you link  this unit with other files  to produce an executable, --
24 -- this  unit  does not  by itself cause  the resulting  executable  to  be --
25 -- covered  by the  GNU  General  Public  License.  This exception does not --
26 -- however invalidate  any other reasons why  the executable file  might be --
27 -- covered by the  GNU Public License.                                      --
28 --                                                                          --
29 -- GNARL was developed by the GNARL team at Florida State University.       --
30 -- Extensive contributions were provided by Ada Core Technologies, Inc.     --
31 --                                                                          --
32 ------------------------------------------------------------------------------
33
34 --  This is a simplified version of the System.Tasking.Stages package,
35 --  intended to be used in a restricted run time.
36
37 --  This package represents the high level tasking interface used by the
38 --  compiler to expand Ada 95 tasking constructs into simpler run time calls
39 --  (aka GNARLI, GNU Ada Run-time Library Interface)
40
41 --  Note: the compiler generates direct calls to this interface, via Rtsfind.
42 --  Any changes to this interface may require corresponding compiler changes
43 --  in exp_ch9.adb and possibly exp_ch7.adb
44
45 --  The restricted GNARLI is also composed of System.Protected_Objects and
46 --  System.Protected_Objects.Single_Entry
47
48 with System.Task_Info;
49 --  used for Task_Info_Type
50
51 with System.Parameters;
52 --  used for Size_Type
53
54 package System.Tasking.Restricted.Stages is
55    pragma Elaborate_Body;
56
57    ---------------------------------
58    -- Compiler Interface (GNARLI) --
59    ---------------------------------
60
61    --  The compiler will expand in the GNAT tree the following construct:
62
63    --   task type T (Discr : Integer);
64
65    --   task body T is
66    --      ...declarations, possibly some controlled...
67    --   begin
68    --      ...B...;
69    --   end T;
70
71    --   T1 : T (1);
72
73    --  as follows:
74
75    --   task type t (discr : integer);
76    --   tE : aliased boolean := false;
77    --   tZ : size_type := unspecified_size;
78
79    --   type tV (discr : integer) is limited record
80    --      _task_id : task_id;
81    --      _atcb : aliased system__tasking__ada_task_control_block (0);
82    --   end record;
83
84    --   procedure tB (_task : access tV);
85    --   freeze tV [
86    --      procedure tVIP (_init : in out tV; _master : master_id;
87    --        _chain : in out activation_chain; _task_name : in string;
88    --        discr : integer) is
89    --      begin
90    --         _init.discr := discr;
91    --         _init._task_id := null;
92    --         system__tasking__ada_task_control_blockIP (_init._atcb, 0);
93    --         _init._task_id := _init._atcb'unchecked_access;
94    --         create_restricted_task (unspecified_priority, tZ,
95    --           unspecified_task_info, task_procedure_access!(tB'address),
96    --           _init'address, tE'unchecked_access, _chain, _task_name, _init.
97    --           _task_id);
98    --         return;
99    --      end tVIP;
100
101    --   _chain : aliased activation_chain;
102    --   activation_chainIP (_chain);
103
104    --   procedure tB (_task : access tV) is
105    --      discr : integer renames _task.discr;
106
107    --      procedure _clean is
108    --      begin
109    --         complete_restricted_task;
110    --         finalize_list (F14b);
111    --         return;
112    --      end _clean;
113
114    --   begin
115    --      ...declarations...
116    --      complete_restricted_activation;
117    --      ...B...;
118    --      return;
119    --   at end
120    --      _clean;
121    --   end tB;
122
123    --   tE := true;
124    --   t1 : t (1);
125    --   t1S : constant String := "t1";
126    --   tIP (t1, 3, _chain, t1S, 1);
127
128    --   activate_restricted_tasks (_chain'unchecked_access);
129
130    procedure Create_Restricted_Task
131      (Priority      : Integer;
132       Stack_Address : System.Address;
133       Size          : System.Parameters.Size_Type;
134       Task_Info     : System.Task_Info.Task_Info_Type;
135       State         : Task_Procedure_Access;
136       Discriminants : System.Address;
137       Elaborated    : Access_Boolean;
138       Chain         : in out Activation_Chain;
139       Task_Image    : String;
140       Created_Task  : Task_Id);
141    --  Compiler interface only. Do not call from within the RTS.
142    --  This must be called to create a new task.
143    --
144    --  Priority is the task's priority (assumed to be in the
145    --  System.Any_Priority'Range)
146    --
147    --  Stack_Address is the start address of the stack associated to the
148    --  task, in case it has been preallocated by the compiler; it is equal
149    --  to Null_Address when the stack needs to be allocated by the
150    --  underlying operating system.
151    --
152    --  Size is the stack size of the task to create
153    --
154    --  Task_Info is the task info associated with the created task, or
155    --  Unspecified_Task_Info if none.
156    --
157    --  State is the compiler generated task's procedure body
158    --
159    --  Discriminants is a pointer to a limited record whose discriminants
160    --  are those of the task to create. This parameter should be passed as
161    --  the single argument to State.
162    --
163    --  Elaborated is a pointer to a Boolean that must be set to true on exit
164    --  if the task could be sucessfully elaborated.
165    --
166    --  Chain is a linked list of task that needs to be created. On exit,
167    --  Created_Task.Activation_Link will be Chain.T_ID, and Chain.T_ID
168    --  will be Created_Task (e.g the created task will be linked at the front
169    --  of Chain).
170    --
171    --  Task_Image is a string created by the compiler that the
172    --  run time can store to ease the debugging and the
173    --  Ada.Task_Identification facility.
174    --
175    --  Created_Task is the resulting task.
176    --
177    --  This procedure can raise Storage_Error if the task creation fails
178
179    procedure Activate_Restricted_Tasks
180      (Chain_Access : Activation_Chain_Access);
181    --  Compiler interface only. Do not call from within the RTS.
182    --  This must be called by the creator of a chain of one or more new tasks,
183    --  to activate them. The chain is a linked list that up to this point is
184    --  only known to the task that created them, though the individual tasks
185    --  are already in the All_Tasks_List.
186    --
187    --  The compiler builds the chain in LIFO order (as a stack). Another
188    --  version of this procedure had code to reverse the chain, so as to
189    --  activate the tasks in the order of declaration. This might be nice, but
190    --  it is not needed if priority-based scheduling is supported, since all
191    --  the activated tasks synchronize on the activators lock before they
192    --  start activating and so they should start activating in priority order.
193
194    procedure Complete_Restricted_Activation;
195    --  Compiler interface only. Do not call from within the RTS.
196    --  This should be called from the task body at the end of
197    --  the elaboration code for its declarative part.
198    --  Decrement the count of tasks to be activated by the activator and
199    --  wake it up so it can check to see if all tasks have been activated.
200    --  Except for the environment task, which should never call this procedure,
201    --  T.Activator should only be null iff T has completed activation.
202
203    procedure Complete_Restricted_Task;
204    --  Compiler interface only. Do not call from within the RTS.
205    --  This should be called from an implicit at-end handler
206    --  associated with the task body, when it completes.
207    --  From this point, the current task will become not callable.
208    --  If the current task have not completed activation, this should be done
209    --  now in order to wake up the activator (the environment task).
210
211    function Restricted_Terminated (T : Task_Id) return Boolean;
212    --  Compiler interface only. Do not call from within the RTS.
213    --  This is called by the compiler to implement the 'Terminated attribute.
214    --
215    --  source code:
216    --     T1'Terminated
217    --
218    --  code expansion:
219    --     restricted_terminated (t1._task_id)
220
221    procedure Finalize_Global_Tasks;
222    --  This is needed to support the compiler interface; it will only be called
223    --  by the Environment task in the binder generated file (by adafinal).
224    --  Instead, it will cause the Environment to block forever, since none of
225    --  the dependent tasks are expected to terminate
226
227 end System.Tasking.Restricted.Stages;