1  /* Implementation of the MVBITS intrinsic
       2     Copyright (C) 2004-2023 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