File : s-atocou.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT RUN-TIME COMPONENTS --
4 -- --
5 -- S Y S T E M . A T O M I C _ C O U N T E R S --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2011-2015, 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 -- --
19 -- --
20 -- --
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 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
29 -- --
30 ------------------------------------------------------------------------------
31
32 -- This is version of the package, for use on platforms where this capability
33 -- is not supported. All Atomic_Counter operations raises Program_Error,
34 -- Atomic_Unsigned operations processed in non-atomic manner.
35
36 package body System.Atomic_Counters is
37
38 ---------------
39 -- Decrement --
40 ---------------
41
42 function Decrement (Item : in out Atomic_Counter) return Boolean is
43 begin
44 raise Program_Error;
45 return False;
46 end Decrement;
47
48 function Decrement (Item : aliased in out Atomic_Unsigned) return Boolean is
49 begin
50 -- Could not use Item := Item - 1; because it is disabled in spec.
51 Item := Atomic_Unsigned'Pred (Item);
52 return Item = 0;
53 end Decrement;
54
55 procedure Decrement (Item : aliased in out Atomic_Unsigned) is
56 begin
57 Item := Atomic_Unsigned'Pred (Item);
58 end Decrement;
59
60 ---------------
61 -- Increment --
62 ---------------
63
64 procedure Increment (Item : in out Atomic_Counter) is
65 begin
66 raise Program_Error;
67 end Increment;
68
69 procedure Increment (Item : aliased in out Atomic_Unsigned) is
70 begin
71 Item := Atomic_Unsigned'Succ (Item);
72 end Increment;
73
74 ----------------
75 -- Initialize --
76 ----------------
77
78 procedure Initialize (Item : out Atomic_Counter) is
79 begin
80 raise Program_Error;
81 end Initialize;
82
83 ------------
84 -- Is_One --
85 ------------
86
87 function Is_One (Item : Atomic_Counter) return Boolean is
88 begin
89 raise Program_Error;
90 return False;
91 end Is_One;
92
93 end System.Atomic_Counters;