Yurttas/PL/IL/Ada-95/F/03/02/01/buffer queue p.adb

From ZCubes Wiki
Revision as of 05:16, 5 November 2013 by MassBot1 (talk | contribs) (Created page with "<syntaxhighlight lang="ada" line start="1" enclose="div">-- -- Copyright(C) 1998 -- All Rights Reserved. Salih Yurttas, ZCubes, BitsOfCode Software Systems, Inc.. -- -- Permis...")
(diff) ← Older revision | Latest revision (diff) | Newer revision → (diff)
Jump to navigation Jump to search
 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-- buffer_queue_p.adb
15
16
17package body Buffer_Queue_P is
18
19  task body Buffer_Queue is
20
21    Q_Size : constant Integer := 128;
22    subtype Q_Range is Integer range 1..Q_Size;
23
24    Length : Integer range 0..Q_Size := 0;
25
26    Head,
27    Tail  : Q_Range := 1;
28
29    Data  : array(Q_Range) of Items;
30
31  begin
32
33    loop
34      select
35        accept Insert(Item : in Items) do
36          if Length = Q_Size then
37            raise Constraint_Error;
38          end if;
39          Data(Tail) := Item;
40        end Insert;
41        Tail := Tail mod Q_Size + 1;
42        Length := Length + 1;
43      or
44        accept Remove(Item : out Items) do
45          if Length = 0 then
46            raise Constraint_Error;
47          end if;
48          Item := Data(Head);
49        end Remove;
50        Head := Head mod Q_Size + 1;
51        Length := Length - 1;
52      or
53        terminate;
54      end select;
55    end loop; 
56
57  end Buffer_Queue;
58
59end Buffer_Queue_P;