Mercurial > hg > CbC > CbC_gcc
comparison gcc/ada/libgnarl/s-tasuti.ads @ 111:04ced10e8804
gcc 7
| author | kono |
|---|---|
| date | Fri, 27 Oct 2017 22:46:09 +0900 |
| parents | |
| children | 84e7813d76e9 |
comparison
equal
deleted
inserted
replaced
| 68:561a7518be6b | 111:04ced10e8804 |
|---|---|
| 1 ------------------------------------------------------------------------------ | |
| 2 -- -- | |
| 3 -- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS -- | |
| 4 -- -- | |
| 5 -- S Y S T E M . T A S K I N G . U T I L I T I E S -- | |
| 6 -- -- | |
| 7 -- S p e c -- | |
| 8 -- -- | |
| 9 -- Copyright (C) 1992-2017, 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 3, or (at your option) any later ver- -- | |
| 14 -- sion. GNAT 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. -- | |
| 17 -- -- | |
| 18 -- As a special exception under Section 7 of GPL version 3, you are granted -- | |
| 19 -- additional permissions described in the GCC Runtime Library Exception, -- | |
| 20 -- version 3.1, as published by the Free Software Foundation. -- | |
| 21 -- -- | |
| 22 -- You should have received a copy of the GNU General Public License and -- | |
| 23 -- a copy of the GCC Runtime Library Exception along with this program; -- | |
| 24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- | |
| 25 -- <http://www.gnu.org/licenses/>. -- | |
| 26 -- -- | |
| 27 -- GNARL was developed by the GNARL team at Florida State University. -- | |
| 28 -- Extensive contributions were provided by Ada Core Technologies, Inc. -- | |
| 29 -- -- | |
| 30 ------------------------------------------------------------------------------ | |
| 31 | |
| 32 -- This package provides RTS Internal Declarations. | |
| 33 -- These declarations are not part of the GNARLI | |
| 34 | |
| 35 with Ada.Unchecked_Conversion; | |
| 36 with System.Task_Primitives; | |
| 37 | |
| 38 package System.Tasking.Utilities is | |
| 39 | |
| 40 function ATCB_To_Address is new | |
| 41 Ada.Unchecked_Conversion (Task_Id, System.Task_Primitives.Task_Address); | |
| 42 | |
| 43 --------------------------------- | |
| 44 -- Task_Stage Related routines -- | |
| 45 --------------------------------- | |
| 46 | |
| 47 function Make_Independent return Boolean; | |
| 48 -- Move the current task to the outermost level (level 2) of the master | |
| 49 -- hierarchy of the environment task. That is one level further out | |
| 50 -- than normal tasks defined in library-level packages (level 3). The | |
| 51 -- environment task will wait for level 3 tasks to terminate normally, | |
| 52 -- then it will abort all the level 2 tasks. See Finalize_Global_Tasks | |
| 53 -- procedure for more information. | |
| 54 -- | |
| 55 -- This is a dangerous operation, and should never be used on nested tasks | |
| 56 -- or tasks that depend on any objects that might be finalized earlier than | |
| 57 -- the termination of the environment task. It is for internal use by the | |
| 58 -- GNARL, to prevent such internal server tasks from preventing a partition | |
| 59 -- from terminating. | |
| 60 -- | |
| 61 -- Also note that the run time assumes that the parent of an independent | |
| 62 -- task is the environment task. If this is not the case, Make_Independent | |
| 63 -- will change the task's parent. This assumption is particularly | |
| 64 -- important for master level completion and for the computation of | |
| 65 -- Independent_Task_Count. | |
| 66 -- | |
| 67 -- NOTE WELL: Make_Independent should be called before the task reaches its | |
| 68 -- "begin", like this: | |
| 69 -- | |
| 70 -- task body Some_Independent_Task is | |
| 71 -- ... | |
| 72 -- Ignore : constant Boolean := Make_Independent; | |
| 73 -- ... | |
| 74 -- begin | |
| 75 -- | |
| 76 -- The return value is meaningless; the only reason this is a function is | |
| 77 -- to get around the Ada limitation that makes a procedure call | |
| 78 -- syntactically illegal before the "begin". | |
| 79 -- | |
| 80 -- Calling it before "begin" ensures that the call completes before the | |
| 81 -- activating task can proceed. This is important for preventing race | |
| 82 -- conditions. For example, if the environment task reaches | |
| 83 -- Finalize_Global_Tasks before some task has finished Make_Independent, | |
| 84 -- the program can hang. | |
| 85 -- | |
| 86 -- Note also that if a package declares independent tasks, it should not | |
| 87 -- initialize its package-body data after "begin" of the package, because | |
| 88 -- that's where the tasks are activated. Initializing such data before the | |
| 89 -- task activation helps prevent the tasks from accessing uninitialized | |
| 90 -- data. | |
| 91 | |
| 92 Independent_Task_Count : Natural := 0; | |
| 93 -- Number of independent tasks. This counter is incremented each time | |
| 94 -- Make_Independent is called. Note that if a server task terminates, | |
| 95 -- this counter will not be decremented. Since Make_Independent locks | |
| 96 -- the environment task (because every independent task depends on it), | |
| 97 -- this counter is protected by the environment task's lock. | |
| 98 | |
| 99 --------------------------------- | |
| 100 -- Task Abort Related Routines -- | |
| 101 --------------------------------- | |
| 102 | |
| 103 procedure Cancel_Queued_Entry_Calls (T : Task_Id); | |
| 104 -- Cancel any entry calls queued on target task. | |
| 105 -- Call this while holding T's lock (or RTS_Lock in Single_Lock mode). | |
| 106 | |
| 107 procedure Exit_One_ATC_Level (Self_ID : Task_Id); | |
| 108 pragma Inline (Exit_One_ATC_Level); | |
| 109 -- Call only with abort deferred and holding lock of Self_ID. | |
| 110 -- This is a bit of common code for all entry calls. | |
| 111 -- The effect is to exit one level of ATC nesting. | |
| 112 | |
| 113 procedure Abort_One_Task (Self_ID : Task_Id; T : Task_Id); | |
| 114 -- Similar to Locked_Abort_To_Level (Self_ID, T, 0), but: | |
| 115 -- (1) caller should be holding no locks | |
| 116 -- (2) may be called for tasks that have not yet been activated | |
| 117 -- (3) always aborts whole task | |
| 118 | |
| 119 procedure Abort_Tasks (Tasks : Task_List); | |
| 120 -- Abort_Tasks is called to initiate abort, however, the actual | |
| 121 -- aborting is done by aborted task by means of Abort_Handler | |
| 122 | |
| 123 procedure Make_Passive (Self_ID : Task_Id; Task_Completed : Boolean); | |
| 124 -- Update counts to indicate current task is either terminated or | |
| 125 -- accepting on a terminate alternative. Call holding no locks except | |
| 126 -- Global_Task_Lock when calling from Terminate_Task, and RTS_Lock when | |
| 127 -- Single_Lock is True. | |
| 128 | |
| 129 end System.Tasking.Utilities; |