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-2005, 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    type Boolean_Array is array (Integer range <>) of Boolean;
  37    pragma Assert (Boolean_Array'Component_Size = 8);
  38    --  Unfortunately Boolean_Array'Component_Size is not a compile-time-known
  39    --  value, so assume it is 8 in order to be able to determine True_Val at
  40    --  compile time.
  41
  42    --  NOTE: The boolean literals must be qualified here to avoid visibility
  43    --  anomalies when this package is compiled through Rtsfind, in a context
  44    --  that includes a user-defined type derived from boolean.
  45
  46    True_Val : constant Vector := Standard.True'Enum_Rep
  47                                    + Standard.True'Enum_Rep * 2**8
  48                                    + Standard.True'Enum_Rep * 2**(8 * 2)
  49                                    + Standard.True'Enum_Rep * 2**(8 * 3)
  50                                    + Standard.True'Enum_Rep * 2**(8 * 4)
  51                                    + Standard.True'Enum_Rep * 2**(8 * 5)
  52                                    + Standard.True'Enum_Rep * 2**(8 * 6)
  53                                    + Standard.True'Enum_Rep * 2**(8 * 7);
  54    --  This constant represents the bits to be flipped to perform a logical
  55    --  "not" on a vector of booleans, independent of the actual
  56    --  representation of True.
  57
  58    --  The representations of (False, True) are assumed to be zero/one and
  59    --  the maximum number of unpacked booleans per Vector is assumed to be 8.
  60
  61    pragma Assert (Standard.False'Enum_Rep = 0);
  62    pragma Assert (Standard.True'Enum_Rep = 1);
  63    pragma Assert (Vector'Size / Storage_Unit <= 8);
  64
  65    --  The reason we need to do these gymnastics is that no call to
  66    --  Unchecked_Conversion can be made at the library level since this
  67    --  unit is pure. Also a conversion from the array type to the Vector type
  68    --  inside the body of "not" is inefficient because of alignment issues.
  69
  70    -----------
  71    -- "not" --
  72    -----------
  73
  74    function "not" (Item : Vectors.Vector) return Vectors.Vector is
  75    begin
  76       return Item xor True_Val;
  77    end "not";
  78
  79    ----------
  80    -- Nand --
  81    ----------
  82
  83    function Nand (Left, Right : Boolean) return Boolean is
  84    begin
  85       return not (Left and Right);
  86    end Nand;
  87
  88    function Nand (Left, Right : Vectors.Vector) return Vectors.Vector is
  89    begin
  90       return not (Left and Right);
  91    end Nand;
  92
  93    ---------
  94    -- Nor --
  95    ---------
  96
  97    function Nor (Left, Right : Boolean) return Boolean is
  98    begin
  99       return not (Left or Right);
 100    end Nor;
 101
 102    function Nor (Left, Right : Vectors.Vector) return Vectors.Vector is
 103    begin
 104       return not (Left or Right);
 105    end Nor;
 106
 107    ----------
 108    -- Nxor --
 109    ----------
 110
 111    function Nxor (Left, Right : Boolean) return Boolean is
 112    begin
 113       return not (Left xor Right);
 114    end Nxor;
 115
 116    function Nxor (Left, Right : Vectors.Vector) return Vectors.Vector is
 117    begin
 118       return not (Left xor Right);
 119    end Nxor;
 120
 121 end System.Vectors.Boolean_Operations;