Pakiet Sem83 - implementacja semaforów dla języka Ada w wersji 83.
Specyfikacja pakietu Sem83.ads
1: package Sem83 is
2: type Semaphore is private;
3: type Binary_Semaphore is private;
4: function Init(N: Integer) return Semaphore;
5: procedure Wait (S: Semaphore);
6: procedure Signal(S: Semaphore);
7: function Init(N: Integer) return Binary_Semaphore;
8: procedure Wait (S: Binary_Semaphore);
9: procedure Signal(S: Binary_Semaphore);
10: Bad_Semaphore_Initialization: exception;
11: private
12: task type Semaphore_Task is
13: entry Init(N: Integer; B: Boolean);
14: entry Wait;
15: entry Signal;
16: end Semaphore_Task;
17: type Semaphore is access Semaphore_Task;
18: type Binary_Semaphore is access Semaphore_Task;
19: end Sem83;
Ciało pakietu Sem83.adb
1: package body Sem83 is
2: task body Semaphore_Task is
3: Binary: Boolean;
4: V: Integer;
5: begin
6: accept Init(N: Integer; B: Boolean) do
7: Binary := B;
8: V := N;
9: end Init;
10: loop
11: select
12: accept Wait do
13: if V > 0 then V := V - 1;
14: else accept Signal;
15: end if;
16: end Wait;
17: or
18: accept Signal do
19: if not Binary or else V = 0 then
20: V := V + 1;
21: end if;
22: end Signal;
23: or
24: terminate;
25: end select;
26: end loop;
27: end Semaphore_Task;
28: function Init(N: Integer) return Semaphore is
29: S: Semaphore;
30: begin
31: if N < 0 then raise Bad_Semaphore_Initialization;
32: else
33: S := new Semaphore_Task;
34: S.Init(N, False);
35: return S;
36: end if;
37: end Init;
38: function Init(N: Integer) return Binary_Semaphore is
39: S: Binary_Semaphore;
40: begin
41: if (N < 0) or (N > 1) then raise Bad_Semaphore_Initialization;
42: else
43: S := new Semaphore_Task;
44: S.Init(N, True);
45: return S;
46: end if;
47: end Init;
48: procedure Wait(S: Semaphore) is
49: begin
50: S.Wait;
51: end Wait;
52: procedure Signal(S: Semaphore) is
53: begin
54: S.Signal;
55: end Signal;
56: procedure Wait(S: Binary_Semaphore) is
57: begin
58: S.Wait;
59: end Wait;
60: procedure Signal(S: Binary_Semaphore) is
61: begin
62: S.Signal;
63: end Signal;
64: end Sem83;
Pakiet Sem95 - implementacja semaforów dla języka Ada w wersji 95.
Specyfikacja pakietu Sem95.ads
1: package Sem95 is
2: type Wart_sem_bin is range 0..1;
3: type Wart_sem_og is range 0..Integer'Last;
4: protected type Semafor_Binarny(Wart_poczatkowa: Wart_sem_bin := 0) is
5: entry PB; -- opuszczenie semafora
6: procedure VB; -- podniesienie semafora
7: private
8: Wart: Wart_sem_bin := Wart_poczatkowa;
9: end Semafor_binarny;
10: Blad_Semafora_binarnego : exception;
11: protected type Semafor(Wart_poczatkowa: Wart_sem_og := 0) is
12: entry P; -- opuszczenie semafora
13: procedure V; -- podniesienie semafora
14: private
15: Wart: Wart_sem_og := Wart_poczatkowa;
16: end Semafor;
17: procedure PB(s: in out Semafor_Binarny); -- odpowiednik operacji Wait()
18: procedure VB(s: in out Semafor_Binarny); -- odpowiednik operacji Signal()
19: procedure P(s: in out Semafor); -- odpowiednik operacji Wait()
20: procedure V(s: in out Semafor); -- odpowiednik operacji Signal()
21: end Sem95;
Ciało pakietu Sem95.adb
1: with text_io; use text_io;
2: package body Sem95 is
3: protected body Semafor_Binarny is
4: entry PB when Wart = 1 is
5: begin
6: Wart := 0;
7: end PB;
8: procedure VB is
9: begin
10: if Wart = 0 then11: Wart := 1;
12: else
13: raise Blad_Semafora_Binarnego;
14: end if;
15: end VB;
16: end Semafor_binarny;
17: protected body Semafor is
18: entry P when Wart > 0 is
19: begin
20: Wart := Wart-1;
21: end P;
22: procedure V is
23: begin
24: Wart := Wart+1;
25: end V;
26: end Semafor;
27: procedure PB(s: in out Semafor_Binarny) is
28: begin
29: s.PB;
30: end PB;
31: procedure VB(s: in out Semafor_Binarny)is
32: begin
33: s.VB;
34: exception
35: when Blad_semafora_binarnego =>
put("UWAGA: Podnoszenie otwartego semafora binarnego");
--Wykrycie bledu powoduje jedynie wyswietlenie komunikatu ostrzegawczego
--Program bedzia dzialal nadal
36: end VB;
37: procedure P(s: in out Semafor)is
38: begin
39: s.P;
40: end P;
41: procedure V(s: in out Semafor)is
42: begin
43: s.V;
44: end V;
45: end Sem95;
Kod źródłowy pochodzi z witryny do książki M. Ben-Ari „Programowanie współbieżne i rozproszone”.
http://stwww.weizmann.ac.il/g-cs/benari/files/pcdp.zip
Kod źródłowy pochodzi z książki G. Gębal „Programowanie współbieżne w Adzie”.