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