Yurttas/PL/IL/Ada-95/F/06/p-c/producer consumer 03.adb

 1--
 2-- Copyright(C) 1998
 3-- All Rights Reserved. Salih Yurttas, ZCubes, BitsOfCode Software Systems, Inc..
 4--
 5-- Permission to use, copy, modify, and distribute this
 6-- software and its documentation for EDUCATIONAL purposes
 7-- and without fee is hereby granted provided that this
 8-- copyright notice appears in all copies.
 9--
10 
11-- date   : January 1, 1998.
12-- author : Salih Yurttas.
13
14-- producer_consumer_03.adb
15
16
17procedure Producer_Consumer_03 is
18
19  type Unit is new Integer;
20
21  task Ring_Buffer is
22    entry G(Item : out Unit);
23    entry P(Item : in Unit);
24  end Ring_Buffer;
25
26  task body Ring_Buffer is
27    No_of_Units : constant := 16;
28
29    Buffers : array(1..No_of_Units) of Unit;
30
31    Full_Slots : Integer range 0..No_of_Units := 0;
32
33    Get_Pointer,
34    Put_Pointer  : Integer range 1..No_of_Units := 1;
35  begin
36    loop
37      select
38        when Full_Slots<No_of_Units =>
39          accept P(Item : in Unit) do
40            Buffers(Put_Pointer) := Item;
41          end P;
42
43          Put_Pointer := Put_Pointer mod No_of_Units+1;
44
45          Full_Slots := Full_Slots + 1;
46
47          Put_Line("P");
48
49      or when Full_Slots>0 =>
50           accept G(Item : out Unit) do
51             Item := Buffers(Get_Pointer);
52           end G;
53
54           Get_Pointer := Get_Pointer mod No_of_Units+1;
55
56           Full_Slots := Full_Slots-1;
57
58           Put_Line("C");
59
60      end select;
61    end loop;
62  end Ring_Buffer;
63
64  task Producer;
65
66  task body Producer is
67    Item : Unit;
68  begin
69    loop
70      Item := 9;
71      Ring_Buffer.P(Item);
72    end loop;
73  end Producer;
74
75  task Consumer;
76
77  task body Consumer is
78    Item : Unit;
79  begin
80    loop
81      Ring_Buffer.G(Item);
82    end loop;
83  end Consumer;
84
85begin
86
87  null;
88
89end Producer_Consumer_03;