1 1.1 mrg /* Implementation of ishftc intrinsic. 2 1.1.1.3 mrg Copyright (C) 2002-2022 Free Software Foundation, Inc. 3 1.1 mrg Contributed by Paul Brook <paul (at) nowt.org> 4 1.1 mrg 5 1.1 mrg This file is part of the GNU Fortran 95 runtime library (libgfortran). 6 1.1 mrg 7 1.1 mrg Libgfortran is free software; you can redistribute it and/or 8 1.1 mrg modify it under the terms of the GNU General Public 9 1.1 mrg License as published by the Free Software Foundation; either 10 1.1 mrg version 3 of the License, or (at your option) any later version. 11 1.1 mrg 12 1.1 mrg Libgfortran is distributed in the hope that it will be useful, 13 1.1 mrg but WITHOUT ANY WARRANTY; without even the implied warranty of 14 1.1 mrg MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 1.1 mrg GNU General Public License for more details. 16 1.1 mrg 17 1.1 mrg Under Section 7 of GPL version 3, you are granted additional 18 1.1 mrg permissions described in the GCC Runtime Library Exception, version 19 1.1 mrg 3.1, as published by the Free Software Foundation. 20 1.1 mrg 21 1.1 mrg You should have received a copy of the GNU General Public License and 22 1.1 mrg a copy of the GCC Runtime Library Exception along with this program; 23 1.1 mrg see the files COPYING3 and COPYING.RUNTIME respectively. If not, see 24 1.1 mrg <http://www.gnu.org/licenses/>. */ 25 1.1 mrg 26 1.1 mrg #include "libgfortran.h" 27 1.1 mrg 28 1.1 mrg extern GFC_INTEGER_4 ishftc4 (GFC_INTEGER_4, GFC_INTEGER_4, GFC_INTEGER_4); 29 1.1 mrg export_proto(ishftc4); 30 1.1 mrg 31 1.1 mrg GFC_INTEGER_4 32 1.1 mrg ishftc4 (GFC_INTEGER_4 i, GFC_INTEGER_4 shift, GFC_INTEGER_4 size) 33 1.1 mrg { 34 1.1 mrg GFC_UINTEGER_4 mask, bits; 35 1.1 mrg 36 1.1 mrg if (shift < 0) 37 1.1 mrg shift = shift + size; 38 1.1 mrg 39 1.1 mrg if (shift == 0 || shift == size) 40 1.1 mrg return i; 41 1.1 mrg 42 1.1 mrg /* In C, the result of the shift operator is undefined if the right operand 43 1.1 mrg is greater than or equal to the number of bits in the left operand. So we 44 1.1 mrg have to special case it for fortran. */ 45 1.1 mrg mask = ~((size == 32) ? (GFC_UINTEGER_4)0 : (~(GFC_UINTEGER_4)0 << size)); 46 1.1 mrg 47 1.1 mrg bits = i & mask; 48 1.1 mrg 49 1.1 mrg return (i & ~mask) | ((bits << shift) & mask) | (bits >> (size - shift)); 50 1.1 mrg } 51 1.1 mrg 52 1.1 mrg extern GFC_INTEGER_8 ishftc8 (GFC_INTEGER_8, GFC_INTEGER_4, GFC_INTEGER_4); 53 1.1 mrg export_proto(ishftc8); 54 1.1 mrg 55 1.1 mrg GFC_INTEGER_8 56 1.1 mrg ishftc8 (GFC_INTEGER_8 i, GFC_INTEGER_4 shift, GFC_INTEGER_4 size) 57 1.1 mrg { 58 1.1 mrg GFC_UINTEGER_8 mask, bits; 59 1.1 mrg 60 1.1 mrg if (shift < 0) 61 1.1 mrg shift = shift + size; 62 1.1 mrg 63 1.1 mrg if (shift == 0 || shift == size) 64 1.1 mrg return i; 65 1.1 mrg 66 1.1 mrg /* In C, the result of the shift operator is undefined if the right operand 67 1.1 mrg is greater than or equal to the number of bits in the left operand. So we 68 1.1 mrg have to special case it for fortran. */ 69 1.1 mrg mask = ~((size == 64) ? (GFC_UINTEGER_8)0 : (~(GFC_UINTEGER_8)0 << size)); 70 1.1 mrg 71 1.1 mrg bits = i & mask; 72 1.1 mrg 73 1.1 mrg return (i & ~mask) | ((bits << shift) & mask) | (bits >> (size - shift)); 74 1.1 mrg } 75 1.1 mrg 76 1.1 mrg #ifdef HAVE_GFC_INTEGER_16 77 1.1 mrg extern GFC_INTEGER_16 ishftc16 (GFC_INTEGER_16, GFC_INTEGER_4, GFC_INTEGER_4); 78 1.1 mrg export_proto(ishftc16); 79 1.1 mrg 80 1.1 mrg GFC_INTEGER_16 81 1.1 mrg ishftc16 (GFC_INTEGER_16 i, GFC_INTEGER_4 shift, GFC_INTEGER_4 size) 82 1.1 mrg { 83 1.1 mrg GFC_UINTEGER_16 mask, bits; 84 1.1 mrg 85 1.1 mrg if (shift < 0) 86 1.1 mrg shift = shift + size; 87 1.1 mrg 88 1.1 mrg if (shift == 0 || shift == size) 89 1.1 mrg return i; 90 1.1 mrg 91 1.1 mrg /* In C, the result of the shift operator is undefined if the right operand 92 1.1 mrg is greater than or equal to the number of bits in the left operand. So we 93 1.1 mrg have to special case it for fortran. */ 94 1.1 mrg mask = ~((size == 128) ? (GFC_UINTEGER_16)0 : (~(GFC_UINTEGER_16)0 << size)); 95 1.1 mrg 96 1.1 mrg bits = i & mask; 97 1.1 mrg 98 1.1 mrg return (i & ~mask) | ((bits << shift) & mask) | (bits >> (size - shift)); 99 1.1 mrg } 100 1.1 mrg #endif 101
Indexes created Sat Apr 11 00:22:22 UTC 2026