]>
Commit | Line | Data |
---|---|---|
d23b8f57 RK |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3084fecd | 3 | -- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS -- |
d23b8f57 RK |
4 | -- -- |
5 | -- A D A . D Y N A M I C _ P R I O R I T I E S -- | |
6 | -- -- | |
7 | -- B o d y -- | |
8 | -- -- | |
4b490c1e | 9 | -- Copyright (C) 1992-2020, Free Software Foundation, Inc. -- |
d23b8f57 RK |
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- -- | |
748086b7 JJ |
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- -- | |
d23b8f57 | 15 | -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- |
748086b7 JJ |
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/>. -- | |
d23b8f57 | 26 | -- -- |
c6362f4f NN |
27 | -- GNARL was developed by the GNARL team at Florida State University. -- |
28 | -- Extensive contributions were provided by Ada Core Technologies, Inc. -- | |
d23b8f57 RK |
29 | -- -- |
30 | ------------------------------------------------------------------------------ | |
31 | ||
d23b8f57 | 32 | with System.Task_Primitives.Operations; |
d23b8f57 | 33 | with System.Tasking; |
07fc65c4 | 34 | with System.Parameters; |
3b91d88e | 35 | with System.Soft_Links; |
d23b8f57 | 36 | |
dae22b53 | 37 | with Ada.Unchecked_Conversion; |
3084fecd | 38 | |
d23b8f57 RK |
39 | package body Ada.Dynamic_Priorities is |
40 | ||
07fc65c4 | 41 | package STPO renames System.Task_Primitives.Operations; |
3b91d88e | 42 | package SSL renames System.Soft_Links; |
07fc65c4 GB |
43 | |
44 | use System.Parameters; | |
d23b8f57 | 45 | use System.Tasking; |
d23b8f57 RK |
46 | |
47 | function Convert_Ids is new | |
dae22b53 | 48 | Ada.Unchecked_Conversion |
b5e792e2 | 49 | (Task_Identification.Task_Id, System.Tasking.Task_Id); |
d23b8f57 RK |
50 | |
51 | ------------------ | |
52 | -- Get_Priority -- | |
53 | ------------------ | |
54 | ||
55 | -- Inquire base priority of a task | |
56 | ||
57 | function Get_Priority | |
58 | (T : Ada.Task_Identification.Task_Id := | |
b5e792e2 AC |
59 | Ada.Task_Identification.Current_Task) return System.Any_Priority |
60 | is | |
61 | Target : constant Task_Id := Convert_Ids (T); | |
d23b8f57 RK |
62 | Error_Message : constant String := "Trying to get the priority of a "; |
63 | ||
64 | begin | |
65 | if Target = Convert_Ids (Ada.Task_Identification.Null_Task_Id) then | |
3b91d88e | 66 | raise Program_Error with Error_Message & "null task"; |
d23b8f57 RK |
67 | end if; |
68 | ||
69 | if Task_Identification.Is_Terminated (T) then | |
1c6b973a | 70 | raise Tasking_Error with Error_Message & "terminated task"; |
d23b8f57 RK |
71 | end if; |
72 | ||
73 | return Target.Common.Base_Priority; | |
74 | end Get_Priority; | |
75 | ||
76 | ------------------ | |
77 | -- Set_Priority -- | |
78 | ------------------ | |
79 | ||
80 | -- Change base priority of a task dynamically | |
81 | ||
82 | procedure Set_Priority | |
83 | (Priority : System.Any_Priority; | |
b5e792e2 | 84 | T : Ada.Task_Identification.Task_Id := |
15f0f591 | 85 | Ada.Task_Identification.Current_Task) |
d23b8f57 | 86 | is |
dae22b53 | 87 | Target : constant Task_Id := Convert_Ids (T); |
d23b8f57 | 88 | Error_Message : constant String := "Trying to set the priority of a "; |
dae22b53 | 89 | Yield_Needed : Boolean; |
d23b8f57 RK |
90 | |
91 | begin | |
92 | if Target = Convert_Ids (Ada.Task_Identification.Null_Task_Id) then | |
3b91d88e | 93 | raise Program_Error with Error_Message & "null task"; |
d23b8f57 RK |
94 | end if; |
95 | ||
1c6b973a AC |
96 | -- Setting the priority of an already-terminated task doesn't do |
97 | -- anything (see RM-D.5.1(7)). Note that Get_Priority is different in | |
98 | -- this regard. | |
99 | ||
d23b8f57 | 100 | if Task_Identification.Is_Terminated (T) then |
1c6b973a | 101 | return; |
d23b8f57 RK |
102 | end if; |
103 | ||
3b91d88e | 104 | SSL.Abort_Defer.all; |
07fc65c4 GB |
105 | |
106 | if Single_Lock then | |
107 | STPO.Lock_RTS; | |
108 | end if; | |
109 | ||
110 | STPO.Write_Lock (Target); | |
d23b8f57 | 111 | |
dae22b53 AC |
112 | Target.Common.Base_Priority := Priority; |
113 | ||
114 | if Target.Common.Call /= null | |
115 | and then | |
116 | Target.Common.Call.Acceptor_Prev_Priority /= Priority_Not_Boosted | |
117 | then | |
118 | -- Target is within a rendezvous, so ensure the correct priority | |
119 | -- will be reset when finishing the rendezvous, and only change the | |
120 | -- priority immediately if the new priority is greater than the | |
121 | -- current (inherited) priority. | |
07fc65c4 | 122 | |
dae22b53 | 123 | Target.Common.Call.Acceptor_Prev_Priority := Priority; |
07fc65c4 | 124 | |
dae22b53 AC |
125 | if Priority >= Target.Common.Current_Priority then |
126 | Yield_Needed := True; | |
127 | STPO.Set_Priority (Target, Priority); | |
128 | else | |
129 | Yield_Needed := False; | |
07fc65c4 GB |
130 | end if; |
131 | ||
dae22b53 AC |
132 | else |
133 | Yield_Needed := True; | |
134 | STPO.Set_Priority (Target, Priority); | |
b5e792e2 | 135 | |
dae22b53 AC |
136 | if Target.Common.State = Entry_Caller_Sleep then |
137 | Target.Pending_Priority_Change := True; | |
138 | STPO.Wakeup (Target, Target.Common.State); | |
139 | end if; | |
140 | end if; | |
b5e792e2 | 141 | |
dae22b53 | 142 | STPO.Unlock (Target); |
07fc65c4 | 143 | |
dae22b53 AC |
144 | if Single_Lock then |
145 | STPO.Unlock_RTS; | |
146 | end if; | |
b5e792e2 | 147 | |
dae22b53 | 148 | if STPO.Self = Target and then Yield_Needed then |
d23b8f57 | 149 | |
dae22b53 | 150 | -- Yield is needed to enforce FIFO task dispatching |
b5e792e2 | 151 | |
dae22b53 AC |
152 | -- LL Set_Priority is made while holding the RTS lock so that it is |
153 | -- inheriting high priority until it release all the RTS locks. | |
d23b8f57 | 154 | |
dae22b53 AC |
155 | -- If this is used in a system where Ceiling Locking is not enforced |
156 | -- we may end up getting two Yield effects. | |
07fc65c4 | 157 | |
dae22b53 | 158 | STPO.Yield; |
d23b8f57 | 159 | end if; |
d23b8f57 | 160 | |
3b91d88e | 161 | SSL.Abort_Undefer.all; |
d23b8f57 RK |
162 | end Set_Priority; |
163 | ||
164 | end Ada.Dynamic_Priorities; |