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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [a-cbprqu.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.BOUNDED_PRIORITY_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
package body Ada.Containers.Bounded_Priority_Queues is
31
 
32
   package body Implementation is
33
 
34
      -------------
35
      -- Dequeue --
36
      -------------
37
 
38
      procedure Dequeue
39
        (List    : in out List_Type;
40
         Element : out Queue_Interfaces.Element_Type)
41
      is
42
      begin
43
         Element := List.Container.First_Element;
44
         List.Container.Delete_First;
45
      end Dequeue;
46
 
47
      procedure Dequeue
48
        (List     : in out List_Type;
49
         At_Least : Queue_Priority;
50
         Element  : in out Queue_Interfaces.Element_Type;
51
         Success  : out Boolean)
52
      is
53
      begin
54
         --  This operation dequeues a high priority item if it exists in the
55
         --  queue. By "high priority" we mean an item whose priority is equal
56
         --  or greater than the value At_Least. The generic formal operation
57
         --  Before has the meaning "has higher priority than". To dequeue an
58
         --  item (meaning that we return True as our Success value), we need
59
         --  as our predicate the equivalent of "has equal or higher priority
60
         --  than", but we cannot say that directly, so we require some logical
61
         --  gymnastics to make it so.
62
 
63
         --  If E is the element at the head of the queue, and symbol ">"
64
         --  refers to the "is higher priority than" function Before, then we
65
         --  derive our predicate as follows:
66
 
67
         --    original: P(E) >= At_Least
68
         --    same as:  not (P(E) < At_Least)
69
         --    same as:  not (At_Least > P(E))
70
         --    same as:  not Before (At_Least, P(E))
71
 
72
         --  But that predicate needs to be true in order to successfully
73
         --  dequeue an item. If it's false, it means no item is dequeued, and
74
         --  we return False as the Success value.
75
 
76
         if List.Length = 0
77
           or else Before (At_Least,
78
                           Get_Priority (List.Container.First_Element))
79
         then
80
            Success := False;
81
            return;
82
         end if;
83
 
84
         List.Dequeue (Element);
85
         Success := True;
86
      end Dequeue;
87
 
88
      -------------
89
      -- Enqueue --
90
      -------------
91
 
92
      procedure Enqueue
93
        (List     : in out List_Type;
94
         New_Item : Queue_Interfaces.Element_Type)
95
      is
96
         P : constant Queue_Priority := Get_Priority (New_Item);
97
 
98
         C : List_Types.Cursor;
99
         use List_Types;
100
 
101
         Count : Count_Type;
102
 
103
      begin
104
         C := List.Container.First;
105
         while Has_Element (C) loop
106
 
107
            --  ??? why is following commented out ???
108
            --  if Before (P, Get_Priority (List.Constant_Reference (C))) then
109
 
110
            if Before (P, Get_Priority (Element (C))) then
111
               List.Container.Insert (C, New_Item);
112
               exit;
113
            end if;
114
 
115
            Next (C);
116
         end loop;
117
 
118
         if not Has_Element (C) then
119
            List.Container.Append (New_Item);
120
         end if;
121
 
122
         Count := List.Container.Length;
123
 
124
         if Count > List.Max_Length then
125
            List.Max_Length := Count;
126
         end if;
127
      end Enqueue;
128
 
129
      -------------------
130
      -- First_Element --
131
      -------------------
132
 
133
      function First_Element
134
        (List : List_Type) return Queue_Interfaces.Element_Type
135
      is
136
      begin
137
 
138
         --  Use Constant_Reference for this.  ???
139
 
140
         return List.Container.First_Element;
141
      end First_Element;
142
 
143
      ------------
144
      -- Length --
145
      ------------
146
 
147
      function Length (List : List_Type) return Count_Type is
148
      begin
149
         return List.Container.Length;
150
      end Length;
151
 
152
      ----------------
153
      -- Max_Length --
154
      ----------------
155
 
156
      function Max_Length (List : List_Type) return Count_Type is
157
      begin
158
         return List.Max_Length;
159
      end Max_Length;
160
 
161
   end Implementation;
162
 
163
   protected body Queue is
164
 
165
      ------------------
166
      --  Current_Use --
167
      ------------------
168
 
169
      function Current_Use return Count_Type is
170
      begin
171
         return List.Length;
172
      end Current_Use;
173
 
174
      --------------
175
      --  Dequeue --
176
      --------------
177
 
178
      entry Dequeue (Element : out Queue_Interfaces.Element_Type)
179
        when List.Length > 0
180
      is
181
      begin
182
         List.Dequeue (Element);
183
      end Dequeue;
184
 
185
      --------------------------------
186
      -- Dequeue_Only_High_Priority --
187
      --------------------------------
188
 
189
      procedure Dequeue_Only_High_Priority
190
        (At_Least : Queue_Priority;
191
         Element  : in out Queue_Interfaces.Element_Type;
192
         Success  : out Boolean)
193
      is
194
      begin
195
         List.Dequeue (At_Least, Element, Success);
196
      end Dequeue_Only_High_Priority;
197
 
198
      --------------
199
      --  Enqueue --
200
      --------------
201
 
202
      entry Enqueue (New_Item : Queue_Interfaces.Element_Type)
203
        when List.Length < Capacity
204
      is
205
      begin
206
         List.Enqueue (New_Item);
207
      end Enqueue;
208
 
209
      ---------------
210
      --  Peak_Use --
211
      ---------------
212
 
213
      function Peak_Use return Count_Type is
214
      begin
215
         return List.Max_Length;
216
      end Peak_Use;
217
 
218
   end Queue;
219
 
220
end Ada.Containers.Bounded_Priority_Queues;

powered by: WebSVN 2.1.0

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