File : s-veboop.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
4 -- --
5 -- S Y S T E M . V E C T O R S . B O O L E A N _ O P E R A T I O N S --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2002-2009, 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 package body System.Vectors.Boolean_Operations is
33
34 SU : constant := Storage_Unit;
35 -- Convenient short hand, used throughout
36
37 -- The coding of this unit depends on the fact that the Component_Size
38 -- of a normally declared array of Boolean is equal to Storage_Unit. We
39 -- can't use the Component_Size directly since it is non-static. The
40 -- following declaration checks that this declaration is correct
41
42 type Boolean_Array is array (Integer range <>) of Boolean;
43 pragma Compile_Time_Error
44 (Boolean_Array'Component_Size /= SU, "run time compile failure");
45
46 -- NOTE: The boolean literals must be qualified here to avoid visibility
47 -- anomalies when this package is compiled through Rtsfind, in a context
48 -- that includes a user-defined type derived from boolean.
49
50 True_Val : constant Vector := Standard.True'Enum_Rep
51 + Standard.True'Enum_Rep * 2**SU
52 + Standard.True'Enum_Rep * 2**(SU * 2)
53 + Standard.True'Enum_Rep * 2**(SU * 3)
54 + Standard.True'Enum_Rep * 2**(SU * 4)
55 + Standard.True'Enum_Rep * 2**(SU * 5)
56 + Standard.True'Enum_Rep * 2**(SU * 6)
57 + Standard.True'Enum_Rep * 2**(SU * 7);
58 -- This constant represents the bits to be flipped to perform a logical
59 -- "not" on a vector of booleans, independent of the actual
60 -- representation of True.
61
62 -- The representations of (False, True) are assumed to be zero/one and
63 -- the maximum number of unpacked booleans per Vector is assumed to be 8.
64
65 pragma Assert (Standard.False'Enum_Rep = 0);
66 pragma Assert (Standard.True'Enum_Rep = 1);
67 pragma Assert (Vector'Size / Storage_Unit <= 8);
68
69 -- The reason we need to do these gymnastics is that no call to
70 -- Unchecked_Conversion can be made at the library level since this
71 -- unit is pure. Also a conversion from the array type to the Vector type
72 -- inside the body of "not" is inefficient because of alignment issues.
73
74 -----------
75 -- "not" --
76 -----------
77
78 function "not" (Item : Vectors.Vector) return Vectors.Vector is
79 begin
80 return Item xor True_Val;
81 end "not";
82
83 ----------
84 -- Nand --
85 ----------
86
87 function Nand (Left, Right : Boolean) return Boolean is
88 begin
89 return not (Left and Right);
90 end Nand;
91
92 function Nand (Left, Right : Vectors.Vector) return Vectors.Vector is
93 begin
94 return not (Left and Right);
95 end Nand;
96
97 ---------
98 -- Nor --
99 ---------
100
101 function Nor (Left, Right : Boolean) return Boolean is
102 begin
103 return not (Left or Right);
104 end Nor;
105
106 function Nor (Left, Right : Vectors.Vector) return Vectors.Vector is
107 begin
108 return not (Left or Right);
109 end Nor;
110
111 ----------
112 -- Nxor --
113 ----------
114
115 function Nxor (Left, Right : Boolean) return Boolean is
116 begin
117 return not (Left xor Right);
118 end Nxor;
119
120 function Nxor (Left, Right : Vectors.Vector) return Vectors.Vector is
121 begin
122 return not (Left xor Right);
123 end Nxor;
124
125 end System.Vectors.Boolean_Operations;