re PR libfortran/19308 (I/O library should support more real and integer kinds)

[thirdparty/gcc.git] / libgfortran / intrinsics / ishftc.c

diff --git a/libgfortran/intrinsics/ishftc.c b/libgfortran/intrinsics/ishftc.c
index f5e7493b7c589680f914758e45c522d424339b37..a147b9683898e3dfa660ee3e3edd004507ed713f 100644 (file)
--- a/libgfortran/intrinsics/ishftc.c
+++ b/libgfortran/intrinsics/ishftc.c
@@ -69,3 +69,25 @@ ishftc8 (GFC_INTEGER_8 i, GFC_INTEGER_4 shift, GFC_INTEGER_4 size)
   bits = i & ~mask;
   return (i & mask) | (bits >> (size - shift)) | ((i << shift) & ~mask);
 }
+
+#ifdef HAVE_GFC_INTEGER_16
+extern GFC_INTEGER_16 ishftc16 (GFC_INTEGER_16, GFC_INTEGER_4, GFC_INTEGER_4);
+export_proto(ishftc16);
+
+GFC_INTEGER_16
+ishftc16 (GFC_INTEGER_16 i, GFC_INTEGER_4 shift, GFC_INTEGER_4 size)
+{
+  GFC_INTEGER_16 mask;
+  GFC_UINTEGER_16 bits;
+
+  if (shift < 0)
+    shift = shift + size;
+
+  if (shift == 0 || shift == size)
+    return i;
+
+  mask = (~(GFC_INTEGER_16)0) << size;
+  bits = i & ~mask;
+  return (i & mask) | (bits >> (size - shift)) | ((i << shift) & ~mask);
+}
+#endif