gcc/ada/libgnat/s-bitfie.ads

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT RUN-TIME COMPONENTS                         --
   4 --                                                                          --
   5 --                 S Y S T E M . B I T F I E L D _ U T I L S                --
   6 --                                                                          --
   7 --                                 S p e c                                  --
   8 --                                                                          --
   9 --               Copyright (C) 2019-2023, 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 -- 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 with System.Bitfield_Utils;
  33
  34 package System.Bitfields is
  35
  36    --  Instances of the generic package in System.Bitfield_Utils. So far
  37    --  we have just one, which defaults to the natural endianness of the
  38    --  machine. We might someday want to support Scalar_Storage_Order.
  39    --  Note: we use Long_Long_Integer'Size / 2 instead of 32 to support
  40    --  specifying a target configuration file where the largest integer is
  41    --  32 bits instead of 64.
  42
  43    Val_Bits  : constant := Long_Long_Integer'Size / 2;
  44    Val_Bytes : constant := Val_Bits / System.Storage_Unit;
  45
  46    type Val_2 is mod 2**(Val_Bits * 2) with Alignment => Val_Bytes;
  47    pragma Provide_Shift_Operators (Val_2);
  48    type Val is mod 2**Val_Bits with Alignment => Val_Bytes;
  49
  50    --  Enabling checks on the instantiation of System.Bitfield_Utils.G makes a
  51    --  latent visibility bug appear on strict alignment platforms related to
  52    --  alignment checks. Work around it by suppressing these checks explicitly.
  53
  54    pragma Suppress (Alignment_Check);
  55    package Utils is new System.Bitfield_Utils.G (Val, Val_2);
  56
  57    procedure Copy_Bitfield
  58      (Src_Address  : Address;
  59       Src_Offset   : Utils.Bit_Offset_In_Byte;
  60       Dest_Address : Address;
  61       Dest_Offset  : Utils.Bit_Offset_In_Byte;
  62       Size         : Utils.Bit_Size)
  63      renames Utils.Copy_Bitfield;
  64
  65    function Fast_Copy_Bitfield
  66      (Src         : Val_2;
  67       Src_Offset  : Utils.Bit_Offset;
  68       Dest        : Val_2;
  69       Dest_Offset : Utils.Bit_Offset;
  70       Size        : Utils.Small_Size)
  71      return Val_2 renames Utils.Fast_Copy_Bitfield;
  72
  73 end System.Bitfields;