libgfortran/intrinsics/mvbits.c

   1 /* Implementation of the MVBITS intrinsic
   2    Copyright (C) 2004 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 Lesser General Public
   9 License as published by the Free Software Foundation; either
  10 version 2.1 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 Lesser General Public License for more details.
  16
  17 You should have received a copy of the GNU Lesser General Public
  18 License along with libgfortran; see the file COPYING.LIB.  If not,
  19 write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  20 Boston, MA 02111-1307, USA.  */
  21
  22 /* TODO: This should be replaced by a compiler builtin.  */
  23
  24 #ifndef SUB_NAME
  25 #include <libgfortran.h>
  26 #endif
  27
  28 #ifdef SUB_NAME
  29 /* MVBITS copies LEN bits starting at bit position FROMPOS from FROM
  30    into TO, starting at bit position TOPOS.  */
  31
  32 void
  33 SUB_NAME (const TYPE *from, const GFC_INTEGER_4 *frompos,
  34           const GFC_INTEGER_4 *len, TYPE *to, const GFC_INTEGER_4 *topos)
  35 {
  36   TYPE oldbits, newbits, lenmask;
  37
  38   lenmask = (*len == sizeof (TYPE)*8) ? ~(TYPE)0 : (1 << *len) - 1;
  39   newbits = (((UTYPE)(*from) >> *frompos) & lenmask) << *topos;
  40   oldbits = *to & (~(lenmask << *topos));
  41
  42   *to = newbits | oldbits;
  43 }
  44 #endif
  45
  46 #ifndef SUB_NAME
  47 #  define TYPE GFC_INTEGER_4
  48 #  define UTYPE GFC_UINTEGER_4
  49 #  define SUB_NAME prefix (mvbits_i4)
  50 #  include "mvbits.c"
  51 #  undef SUB_NAME
  52 #  undef TYPE
  53 #  undef UTYPE
  54
  55 #  define TYPE GFC_INTEGER_8
  56 #  define UTYPE GFC_UINTEGER_8
  57 #  define SUB_NAME prefix (mvbits_i8)
  58 #  include "mvbits.c"
  59 #  undef SUB_NAME
  60 #  undef TYPE
  61 #  undef UTYPE
  62 #endif
  63