OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [a-cusyqu.adb] - Blame information for rev 706

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 706 jeremybenn
------------------------------------------------------------------------------
2
--                                                                          --
3
--                         GNAT LIBRARY COMPONENTS                          --
4
--                                                                          --
5
--               ADA.CONTAINERS.UNBOUNDED_SYNCHRONIZED_QUEUES               --
6
--                                                                          --
7
--                                 B o d y                                  --
8
--                                                                          --
9
--            Copyright (C) 2011, Free Software Foundation, Inc.            --
10
--                                                                          --
11
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
12
-- terms of the  GNU General Public License as published  by the Free Soft- --
13
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
14
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
15
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
16
-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
17
--                                                                          --
18
-- As a special exception under Section 7 of GPL version 3, you are granted --
19
-- additional permissions described in the GCC Runtime Library Exception,   --
20
-- version 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
-- This unit was originally developed by Matthew J Heaney.                  --
28
------------------------------------------------------------------------------
29
 
30
with Ada.Unchecked_Deallocation;
31
 
32
package body Ada.Containers.Unbounded_Synchronized_Queues is
33
 
34
   package body Implementation is
35
 
36
      -----------------------
37
      -- Local Subprograms --
38
      -----------------------
39
 
40
      procedure Free is
41
         new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
42
 
43
      -------------
44
      -- Dequeue --
45
      -------------
46
 
47
      procedure Dequeue
48
        (List    : in out List_Type;
49
         Element : out Queue_Interfaces.Element_Type)
50
      is
51
         X : Node_Access;
52
 
53
      begin
54
         Element := List.First.Element;
55
 
56
         X := List.First;
57
         List.First := List.First.Next;
58
 
59
         if List.First = null then
60
            List.Last := null;
61
         end if;
62
 
63
         List.Length := List.Length - 1;
64
 
65
         Free (X);
66
      end Dequeue;
67
 
68
      -------------
69
      -- Enqueue --
70
      -------------
71
 
72
      procedure Enqueue
73
        (List     : in out List_Type;
74
         New_Item : Queue_Interfaces.Element_Type)
75
      is
76
         Node : Node_Access;
77
 
78
      begin
79
         Node := new Node_Type'(New_Item, null);
80
 
81
         if List.First = null then
82
            List.First := Node;
83
            List.Last := List.First;
84
 
85
         else
86
            List.Last.Next := Node;
87
            List.Last := Node;
88
         end if;
89
 
90
         List.Length := List.Length + 1;
91
 
92
         if List.Length > List.Max_Length then
93
            List.Max_Length := List.Length;
94
         end if;
95
      end Enqueue;
96
 
97
      --------------
98
      -- Finalize --
99
      --------------
100
 
101
      procedure Finalize (List : in out List_Type) is
102
         X : Node_Access;
103
 
104
      begin
105
         while List.First /= null loop
106
            X := List.First;
107
            List.First := List.First.Next;
108
            Free (X);
109
         end loop;
110
      end Finalize;
111
 
112
      ------------
113
      -- Length --
114
      ------------
115
 
116
      function Length (List : List_Type) return Count_Type is
117
      begin
118
         return List.Length;
119
      end Length;
120
 
121
      ----------------
122
      -- Max_Length --
123
      ----------------
124
 
125
      function Max_Length (List : List_Type) return Count_Type is
126
      begin
127
         return List.Max_Length;
128
      end Max_Length;
129
 
130
   end Implementation;
131
 
132
   protected body Queue is
133
 
134
      -----------------
135
      -- Current_Use --
136
      -----------------
137
 
138
      function Current_Use return Count_Type is
139
      begin
140
         return List.Length;
141
      end Current_Use;
142
 
143
      -------------
144
      -- Dequeue --
145
      -------------
146
 
147
      entry Dequeue (Element : out Queue_Interfaces.Element_Type)
148
        when List.Length > 0
149
      is
150
      begin
151
         List.Dequeue (Element);
152
      end Dequeue;
153
 
154
      -------------
155
      -- Enqueue --
156
      -------------
157
 
158
      entry Enqueue (New_Item : Queue_Interfaces.Element_Type) when True is
159
      begin
160
         List.Enqueue (New_Item);
161
      end Enqueue;
162
 
163
      --------------
164
      -- Peak_Use --
165
      --------------
166
 
167
      function Peak_Use return Count_Type is
168
      begin
169
         return List.Max_Length;
170
      end Peak_Use;
171
 
172
   end Queue;
173
 
174
end Ada.Containers.Unbounded_Synchronized_Queues;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.