libgfortran/intrinsics/mvbits.c

   1 /* Implementation of the MVBITS intrinsic
   2    Copyright (C) 2004-2016 Free Software Foundation, Inc.
   3    Contributed by Tobias Schlüter
   4
   5 This file is part of the GNU Fortran 95 runtime library (libgfortran).
   6
   7 Libgfortran is free software; you can redistribute it and/or
   8 modify it under the terms of the GNU General Public
   9 License as published by the Free Software Foundation; either
  10 version 3 of the License, or (at your option) any later version.
  11
  12 Libgfortran is distributed in the hope that it will be useful,
  13 but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 GNU General Public License for more details.
  16
  17 Under Section 7 of GPL version 3, you are granted additional
  18 permissions described in the GCC Runtime Library Exception, version
  19 3.1, as published by the Free Software Foundation.
  20
  21 You should have received a copy of the GNU General Public License and
  22 a copy of the GCC Runtime Library Exception along with this program;
  23 see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
  24 <http://www.gnu.org/licenses/>.  */
  25
  26 /* TODO: This should be replaced by a compiler builtin.  */
  27
  28 #ifndef SUB_NAME
  29 #include <libgfortran.h>
  30 #endif
  31
  32 #ifdef SUB_NAME
  33 /* MVBITS copies LEN bits starting at bit position FROMPOS from FROM
  34    into TO, starting at bit position TOPOS.  */
  35
  36 extern void SUB_NAME (const TYPE *, const int *, const int *, TYPE *,
  37                       const int *);
  38 export_proto(SUB_NAME);
  39
  40 void
  41 SUB_NAME (const TYPE *from, const int *frompos, const int *len, TYPE *to,
  42           const int *topos)
  43 {
  44   TYPE oldbits, newbits, lenmask;
  45
  46   lenmask = (*len == sizeof (TYPE)*8) ? ~(TYPE)0 : ((TYPE)1 << *len) - 1;
  47   newbits = (((UTYPE)(*from) >> *frompos) & lenmask) << *topos;
  48   oldbits = *to & (~(lenmask << *topos));
  49
  50   *to = newbits | oldbits;
  51 }
  52 #endif
  53
  54 #ifndef SUB_NAME
  55 #  define TYPE GFC_INTEGER_1
  56 #  define UTYPE GFC_UINTEGER_1
  57 #  define SUB_NAME mvbits_i1
  58 #  include "mvbits.c"
  59 #  undef SUB_NAME
  60 #  undef TYPE
  61 #  undef UTYPE
  62
  63 #  define TYPE GFC_INTEGER_2
  64 #  define UTYPE GFC_UINTEGER_2
  65 #  define SUB_NAME mvbits_i2
  66 #  include "mvbits.c"
  67 #  undef SUB_NAME
  68 #  undef TYPE
  69 #  undef UTYPE
  70
  71 #  define TYPE GFC_INTEGER_4
  72 #  define UTYPE GFC_UINTEGER_4
  73 #  define SUB_NAME mvbits_i4
  74 #  include "mvbits.c"
  75 #  undef SUB_NAME
  76 #  undef TYPE
  77 #  undef UTYPE
  78
  79 #  define TYPE GFC_INTEGER_8
  80 #  define UTYPE GFC_UINTEGER_8
  81 #  define SUB_NAME mvbits_i8
  82 #  include "mvbits.c"
  83 #  undef SUB_NAME
  84 #  undef TYPE
  85 #  undef UTYPE
  86
  87 #if defined (HAVE_GFC_INTEGER_16)
  88 #  define TYPE GFC_INTEGER_16
  89 #  define UTYPE GFC_UINTEGER_16
  90 #  define SUB_NAME mvbits_i16
  91 #  include "mvbits.c"
  92 #  undef SUB_NAME
  93 #  undef TYPE
  94 #  undef UTYPE
  95 #endif
  96 #endif