gcc/ada/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-2007, 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 2,  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.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  19 -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
  20 -- Boston, MA 02110-1301, USA.                                              --
  21 --                                                                          --
  22 -- As a special exception,  if other files  instantiate  generics from this --
  23 -- unit, or you link  this unit with other files  to produce an executable, --
  24 -- this  unit  does not  by itself cause  the resulting  executable  to  be --
  25 -- covered  by the  GNU  General  Public  License.  This exception does not --
  26 -- however invalidate  any other reasons why  the executable file  might be --
  27 -- covered by the  GNU Public License.                                      --
  28 --                                                                          --
  29 -- GNAT was originally developed  by the GNAT team at  New York University. --
  30 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  31 --                                                                          --
  32 ------------------------------------------------------------------------------
  33
  34 package body System.Vectors.Boolean_Operations is
  35
  36    SU : constant := Storage_Unit;
  37    --  Convenient short hand, used throughout
  38
  39    --  The coding of this unit depends on the fact that the Component_Size
  40    --  of a normally declared array of Boolean is equal to Storage_Unit. We
  41    --  can't use the Component_Size directly since it is non-static. The
  42    --  following declaration checks that this declaration is correct
  43
  44    type Boolean_Array is array (Integer range <>) of Boolean;
  45    pragma Compile_Time_Error
  46      (Boolean_Array'Component_Size /= SU, "run time compile failure");
  47
  48    --  NOTE: The boolean literals must be qualified here to avoid visibility
  49    --  anomalies when this package is compiled through Rtsfind, in a context
  50    --  that includes a user-defined type derived from boolean.
  51
  52    True_Val : constant Vector := Standard.True'Enum_Rep
  53                                    + Standard.True'Enum_Rep * 2**SU
  54                                    + Standard.True'Enum_Rep * 2**(SU * 2)
  55                                    + Standard.True'Enum_Rep * 2**(SU * 3)
  56                                    + Standard.True'Enum_Rep * 2**(SU * 4)
  57                                    + Standard.True'Enum_Rep * 2**(SU * 5)
  58                                    + Standard.True'Enum_Rep * 2**(SU * 6)
  59                                    + Standard.True'Enum_Rep * 2**(SU * 7);
  60    --  This constant represents the bits to be flipped to perform a logical
  61    --  "not" on a vector of booleans, independent of the actual
  62    --  representation of True.
  63
  64    --  The representations of (False, True) are assumed to be zero/one and
  65    --  the maximum number of unpacked booleans per Vector is assumed to be 8.
  66
  67    pragma Assert (Standard.False'Enum_Rep = 0);
  68    pragma Assert (Standard.True'Enum_Rep = 1);
  69    pragma Assert (Vector'Size / Storage_Unit <= 8);
  70
  71    --  The reason we need to do these gymnastics is that no call to
  72    --  Unchecked_Conversion can be made at the library level since this
  73    --  unit is pure. Also a conversion from the array type to the Vector type
  74    --  inside the body of "not" is inefficient because of alignment issues.
  75
  76    -----------
  77    -- "not" --
  78    -----------
  79
  80    function "not" (Item : Vectors.Vector) return Vectors.Vector is
  81    begin
  82       return Item xor True_Val;
  83    end "not";
  84
  85    ----------
  86    -- Nand --
  87    ----------
  88
  89    function Nand (Left, Right : Boolean) return Boolean is
  90    begin
  91       return not (Left and Right);
  92    end Nand;
  93
  94    function Nand (Left, Right : Vectors.Vector) return Vectors.Vector is
  95    begin
  96       return not (Left and Right);
  97    end Nand;
  98
  99    ---------
 100    -- Nor --
 101    ---------
 102
 103    function Nor (Left, Right : Boolean) return Boolean is
 104    begin
 105       return not (Left or Right);
 106    end Nor;
 107
 108    function Nor (Left, Right : Vectors.Vector) return Vectors.Vector is
 109    begin
 110       return not (Left or Right);
 111    end Nor;
 112
 113    ----------
 114    -- Nxor --
 115    ----------
 116
 117    function Nxor (Left, Right : Boolean) return Boolean is
 118    begin
 119       return not (Left xor Right);
 120    end Nxor;
 121
 122    function Nxor (Left, Right : Vectors.Vector) return Vectors.Vector is
 123    begin
 124       return not (Left xor Right);
 125    end Nxor;
 126
 127 end System.Vectors.Boolean_Operations;