]>
Commit | Line | Data |
---|---|---|
1eee94d3 GM |
1 | (* Semaphores.mod implement the ISO Semaphores specification. |
2 | ||
83ffe9cd | 3 | Copyright (C) 2010-2023 Free Software Foundation, Inc. |
1eee94d3 GM |
4 | Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>. |
5 | ||
6 | This file is part of GNU Modula-2. | |
7 | ||
8 | GNU Modula-2 is free software; you can redistribute it and/or modify | |
9 | it under the terms of the GNU General Public License as published by | |
10 | the Free Software Foundation; either version 3, or (at your option) | |
11 | any later version. | |
12 | ||
13 | GNU Modula-2 is distributed in the hope that it will be useful, but | |
14 | WITHOUT ANY WARRANTY; without even the implied warranty of | |
15 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
16 | General Public License for more details. | |
17 | ||
18 | Under Section 7 of GPL version 3, you are granted additional | |
19 | permissions described in the GCC Runtime Library Exception, version | |
20 | 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 | IMPLEMENTATION MODULE Semaphores ; | |
28 | ||
29 | (* Provides mutual exclusion facilities for use by processes. *) | |
30 | ||
31 | FROM Storage IMPORT ALLOCATE ; | |
32 | FROM Processes IMPORT ProcessId, Me, SuspendMe, Activate, UrgencyOf ; | |
33 | ||
34 | ||
35 | TYPE | |
36 | SEMAPHORE = POINTER TO RECORD | |
37 | value: CARDINAL ; | |
38 | next : SEMAPHORE ; | |
39 | head : ProcessList ; | |
40 | END ; | |
41 | ||
42 | ProcessList = POINTER TO RECORD | |
43 | waiting: ProcessId ; | |
44 | right, | |
45 | left : ProcessList ; | |
46 | END ; | |
47 | ||
48 | VAR | |
49 | freeSem : SEMAPHORE ; | |
50 | freeProcessList: ProcessList ; | |
51 | ||
52 | ||
53 | (* | |
54 | Create - creates and returns s as the identity of a new | |
55 | semaphore that has its associated count initialized | |
56 | to initialCount, and has no processes yet waiting on it. | |
57 | *) | |
58 | ||
59 | PROCEDURE Create (VAR s: SEMAPHORE; initialCount: CARDINAL) ; | |
60 | BEGIN | |
61 | s := newSemaphore () ; | |
62 | WITH s^ DO | |
63 | value := initialCount ; | |
64 | next := NIL ; | |
65 | head := NIL | |
66 | END | |
67 | END Create ; | |
68 | ||
69 | ||
70 | (* | |
71 | Destroy - recovers the resources used to implement the semaphore s, | |
72 | provided that no process is waiting for s to become free. | |
73 | *) | |
74 | ||
75 | PROCEDURE Destroy (VAR s: SEMAPHORE) ; | |
76 | BEGIN | |
77 | WITH s^ DO | |
78 | IF head=NIL | |
79 | THEN | |
80 | next := freeSem ; | |
81 | freeSem := s | |
82 | ELSE | |
83 | (* raise exception? *) | |
84 | END | |
85 | END | |
86 | END Destroy ; | |
87 | ||
88 | ||
89 | (* | |
90 | newSemaphore - | |
91 | *) | |
92 | ||
93 | PROCEDURE newSemaphore () : SEMAPHORE ; | |
94 | VAR | |
95 | s: SEMAPHORE ; | |
96 | BEGIN | |
97 | IF freeSem=NIL | |
98 | THEN | |
99 | NEW (s) | |
100 | ELSE | |
101 | s := freeSem ; | |
102 | freeSem := freeSem^.next | |
103 | END ; | |
104 | RETURN s | |
105 | END newSemaphore ; | |
106 | ||
107 | ||
108 | (* | |
109 | newProcessList - returns a new ProcessList. | |
110 | *) | |
111 | ||
112 | PROCEDURE newProcessList () : ProcessList ; | |
113 | VAR | |
114 | l: ProcessList ; | |
115 | BEGIN | |
116 | IF freeProcessList=NIL | |
117 | THEN | |
118 | NEW (l) | |
119 | ELSE | |
120 | l := freeProcessList ; | |
121 | freeProcessList := freeProcessList^.right | |
122 | END ; | |
123 | RETURN l | |
124 | END newProcessList ; | |
125 | ||
126 | ||
127 | (* | |
128 | add - adds process, p, to queue, head. | |
129 | *) | |
130 | ||
131 | PROCEDURE add (VAR head: ProcessList; p: ProcessList) ; | |
132 | BEGIN | |
133 | IF head=NIL | |
134 | THEN | |
135 | head := p ; | |
136 | p^.left := p ; | |
137 | p^.right := p | |
138 | ELSE | |
139 | p^.right := head ; | |
140 | p^.left := head^.left ; | |
141 | head^.left^.right := p ; | |
142 | head^.left := p | |
143 | END | |
144 | END add ; | |
145 | ||
146 | ||
147 | (* | |
148 | sub - subtracts process, p, from queue, head. | |
149 | *) | |
150 | ||
151 | PROCEDURE sub (VAR head: ProcessList; p: ProcessList) ; | |
152 | BEGIN | |
153 | IF (p^.left=head) AND (p=head) | |
154 | THEN | |
155 | head := NIL | |
156 | ELSE | |
157 | IF head=p | |
158 | THEN | |
159 | head := head^.right | |
160 | END ; | |
161 | p^.left^.right := p^.right ; | |
162 | p^.right^.left := p^.left | |
163 | END | |
164 | END sub ; | |
165 | ||
166 | ||
167 | (* | |
168 | addProcess - adds the current process to the semaphore list. | |
169 | Remove the current process from the ready queue. | |
170 | *) | |
171 | ||
172 | PROCEDURE addProcess (VAR head: ProcessList) ; | |
173 | VAR | |
174 | l: ProcessList ; | |
175 | BEGIN | |
176 | l := newProcessList() ; | |
177 | WITH l^ DO | |
178 | waiting := Me () ; | |
179 | right := NIL ; | |
180 | left := NIL | |
181 | END ; | |
182 | add (head, l) ; | |
183 | SuspendMe | |
184 | END addProcess ; | |
185 | ||
186 | ||
187 | (* | |
188 | chooseProcess - | |
189 | *) | |
190 | ||
191 | PROCEDURE chooseProcess (head: ProcessList) : ProcessList ; | |
192 | VAR | |
193 | best, l: ProcessList ; | |
194 | BEGIN | |
195 | best := head ; | |
196 | l := head^.right ; | |
197 | WHILE l#head DO | |
198 | IF UrgencyOf (l^.waiting) > UrgencyOf (best^.waiting) | |
199 | THEN | |
200 | best := l | |
201 | END ; | |
202 | l := l^.right | |
203 | END ; | |
204 | RETURN best | |
205 | END chooseProcess ; | |
206 | ||
207 | ||
208 | (* | |
209 | removeProcess - removes process, l, from the list and adds it to the | |
210 | ready queue. | |
211 | *) | |
212 | ||
213 | PROCEDURE removeProcess (VAR head: ProcessList; l: ProcessList) ; | |
214 | BEGIN | |
215 | sub (head, l) ; | |
216 | WITH l^ DO | |
217 | right := freeProcessList ; | |
218 | freeProcessList := l ; | |
219 | Activate (waiting) | |
220 | END | |
221 | END removeProcess ; | |
222 | ||
223 | ||
224 | (* | |
225 | Claim - if the count associated with the semaphore s is non-zero, | |
226 | decrements this count and allows the calling process to | |
227 | continue; otherwise suspends the calling process until | |
228 | s is released. | |
229 | *) | |
230 | ||
231 | PROCEDURE Claim (s: SEMAPHORE) ; | |
232 | BEGIN | |
233 | WITH s^ DO | |
234 | IF value>0 | |
235 | THEN | |
236 | DEC (value) | |
237 | ELSE | |
238 | addProcess (head) | |
239 | END | |
240 | END | |
241 | END Claim ; | |
242 | ||
243 | ||
244 | (* | |
245 | Release - if there are any processes waiting on the semaphore s, | |
246 | allows one of them to enter the ready state; otherwise | |
247 | increments the count associated with s. | |
248 | *) | |
249 | ||
250 | PROCEDURE Release (s: SEMAPHORE) ; | |
251 | BEGIN | |
252 | WITH s^ DO | |
253 | IF head=NIL | |
254 | THEN | |
255 | INC (value) | |
256 | ELSE | |
257 | removeProcess (head, chooseProcess (head)) | |
258 | END | |
259 | END | |
260 | END Release ; | |
261 | ||
262 | ||
263 | (* | |
264 | CondClaim - returns FALSE if the call Claim(s) would cause the calling | |
265 | process to be suspended; in this case the count associated | |
266 | with s is not changed. Otherwise returns TRUE and the | |
267 | associated count is decremented. | |
268 | *) | |
269 | ||
270 | PROCEDURE CondClaim (s: SEMAPHORE) : BOOLEAN ; | |
271 | BEGIN | |
272 | WITH s^ DO | |
273 | IF value>0 | |
274 | THEN | |
275 | DEC (value) ; | |
276 | RETURN TRUE | |
277 | ELSE | |
278 | RETURN FALSE | |
279 | END | |
280 | END | |
281 | END CondClaim ; | |
282 | ||
283 | ||
284 | BEGIN | |
285 | freeSem := NIL ; | |
286 | freeProcessList := NIL | |
287 | END Semaphores. |