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”.