trans-intrinsic.c (gfc_conv_intrinsic_ishft): Change to logicalshift.

gcc/fortran/
* trans-intrinsic.c (gfc_conv_intrinsic_ishft): Change to
logicalshift.  Call fold.  Remove 0-bit shift shortcut.
(gfc_conv_intrinsic_ishftc): Convert first argument to at least
4 bytes bits.  Convert 2nd and 3rd argument to 4 bytes.  Convert
result if width(arg 1) < 4 bytes.  Call fold.

libgfortran/
* libgfortran/libgfortran.h (GFC_UINTEGER_1, GFC_UINTEGER_2):
Define.
* intrinsics/ishftc.c: Update copyright years.
(ishftc8): Change 'shift' and 'size' to GFC_INTEGER_4.
* intrinsics/mvbits.c: Correcty non-ASCII character in my name.
Add implementations for GFC_INTEGER_1 and GFC_INTEGER_2.

gcc/testsuite/
* gfortran.dg/g77/f90-intrinsic-bit.f: New.

From-SVN: r92642

8 files changed, 567 insertions, 33 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 23e9339..5f2707e 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2004-12-27  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de> 
+
+	* trans-intrinsic.c (gfc_conv_intrinsic_ishft): Change to
+	logical	shift.  Call fold.  Remove 0-bit shift shortcut.
+	(gfc_conv_intrinsic_ishftc): Convert first argument to at least
+	4 bytes bits.  Convert 2nd and 3rd argument to 4 bytes.  Convert
+	result if width(arg 1) < 4 bytes.  Call fold.
+
 2004-12-23  Steven G. Kargl  <kargls@comcast.net>
 
 	* gfortran.texi: Fix typo.
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index e11aa30..56def1a 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -1774,14 +1774,21 @@ gfc_conv_intrinsic_ibits (gfc_se * se, gfc_expr * expr)
   se->expr = fold (build2 (BIT_AND_EXPR, type, tmp, mask));
 }
 
-/* ISHFT (I, SHIFT) = (shift >= 0) ? i << shift : i >> -shift.  */
+/* ISHFT (I, SHIFT) = (abs (shift) >= BIT_SIZE (i))
+                        ? 0
+	 	        : ((shift >= 0) ? i << shift : i >> -shift)
+   where all shifts are logical shifts.  */
 static void
 gfc_conv_intrinsic_ishft (gfc_se * se, gfc_expr * expr)
 {
   tree arg;
   tree arg2;
   tree type;
+  tree utype;
   tree tmp;
+  tree width;
+  tree num_bits;
+  tree cond;
   tree lshift;
   tree rshift;
 
@@ -1789,23 +1796,36 @@ gfc_conv_intrinsic_ishft (gfc_se * se, gfc_expr * expr)
   arg2 = TREE_VALUE (TREE_CHAIN (arg));
   arg = TREE_VALUE (arg);
   type = TREE_TYPE (arg);
+  utype = gfc_unsigned_type (type);
+
+  /* We convert to an unsigned type because we want a logical shift.
+     The standard doesn't define the case of shifting negative
+     numbers, and we try to be compatible with other compilers, most
+     notably g77, here.  */
+  arg = convert (utype, arg);
+  width = fold (build1 (ABS_EXPR, TREE_TYPE (arg2), arg2));
 
   /* Left shift if positive.  */
-  lshift = build2 (LSHIFT_EXPR, type, arg, arg2);
+  lshift = fold (build2 (LSHIFT_EXPR, type, arg, width));
 
-  /* Right shift if negative.  This will perform an arithmetic shift as
-     we are dealing with signed integers.  Section 13.5.7 allows this.  */
-  tmp = build1 (NEGATE_EXPR, TREE_TYPE (arg2), arg2);
-  rshift = build2 (RSHIFT_EXPR, type, arg, tmp);
+  /* Right shift if negative.  */
+  rshift = convert (type, fold (build2 (RSHIFT_EXPR, utype, arg, width)));
 
-  tmp = build2 (GT_EXPR, boolean_type_node, arg2,
-		convert (TREE_TYPE (arg2), integer_zero_node));
-  rshift = build3 (COND_EXPR, type, tmp, lshift, rshift);
+  tmp = fold (build2 (GE_EXPR, boolean_type_node, arg2,
+		      convert (TREE_TYPE (arg2), integer_zero_node)));
+  tmp = fold (build3 (COND_EXPR, type, tmp, lshift, rshift));
 
-  /* Do nothing if shift == 0.  */
-  tmp = build2 (EQ_EXPR, boolean_type_node, arg2,
-		convert (TREE_TYPE (arg2), integer_zero_node));
-  se->expr = build3 (COND_EXPR, type, tmp, arg, rshift);
+  /* The Fortran standard allows shift widths <= BIT_SIZE(I), whereas
+     gcc requires a shift width < BIT_SIZE(I), so we have to catch this
+     special case.  */
+  num_bits = convert (TREE_TYPE (arg2),	
+		      build_int_cst (NULL, TYPE_PRECISION (type)));
+  cond = fold (build2 (GE_EXPR, boolean_type_node, width,
+		       convert (TREE_TYPE (arg2), num_bits)));
+
+  se->expr = fold (build3 (COND_EXPR, type, cond, 
+			   convert (type, integer_zero_node),
+			   tmp));
 }
 
 /* Circular shift.  AKA rotate or barrel shift.  */
@@ -1826,17 +1846,28 @@ gfc_conv_intrinsic_ishftc (gfc_se * se, gfc_expr * expr)
   if (arg3)
     {
       /* Use a library function for the 3 parameter version.  */
+      tree int4type = gfc_get_int_type (4);
+
       type = TREE_TYPE (TREE_VALUE (arg));
-      /* Convert all args to the same type otherwise we need loads of library
-         functions.  SIZE and SHIFT cannot have values > BIT_SIZE (I) so the
-         conversion is safe.  */
-      tmp = convert (type, TREE_VALUE (arg2));
-      TREE_VALUE (arg2) = tmp;
-      tmp = convert (type, TREE_VALUE (arg3));
-      TREE_VALUE (arg3) = tmp;
+      /* We convert the first argument to at least 4 bytes, and
+	 convert back afterwards.  This removes the need for library
+	 functions for all argument sizes, and function will be
+	 aligned to at least 32 bits, so there's no loss.  */
+      if (expr->ts.kind < 4)
+	{
+	  tmp = convert (int4type, TREE_VALUE (arg));
+	  TREE_VALUE (arg) = tmp;
+	}
+      /* Convert the SHIFT and SIZE args to INTEGER*4 otherwise we would
+         need loads of library  functions.  They cannot have values >
+	 BIT_SIZE (I) so the conversion is safe.  */
+      TREE_VALUE (arg2) = convert (int4type, TREE_VALUE (arg2));
+      TREE_VALUE (arg3) = convert (int4type, TREE_VALUE (arg3));
 
       switch (expr->ts.kind)
 	{
+	case 1:
+	case 2:
 	case 4:
 	  tmp = gfor_fndecl_math_ishftc4;
 	  break;
@@ -1847,6 +1878,11 @@ gfc_conv_intrinsic_ishftc (gfc_se * se, gfc_expr * expr)
 	  gcc_unreachable ();
 	}
       se->expr = gfc_build_function_call (tmp, arg);
+      /* Convert the result back to the original type, if we extended
+	 the first argument's width above.  */
+      if (expr->ts.kind < 4)
+	se->expr = convert (type, se->expr);
+
       return;
     }
   arg = TREE_VALUE (arg);
@@ -1854,20 +1890,20 @@ gfc_conv_intrinsic_ishftc (gfc_se * se, gfc_expr * expr)
   type = TREE_TYPE (arg);
 
   /* Rotate left if positive.  */
-  lrot = build2 (LROTATE_EXPR, type, arg, arg2);
+  lrot = fold (build2 (LROTATE_EXPR, type, arg, arg2));
 
   /* Rotate right if negative.  */
-  tmp = build1 (NEGATE_EXPR, TREE_TYPE (arg2), arg2);
-  rrot = build2 (RROTATE_EXPR, type, arg, tmp);
+  tmp = fold (build1 (NEGATE_EXPR, TREE_TYPE (arg2), arg2));
+  rrot = fold (build2 (RROTATE_EXPR, type, arg, tmp));
 
-  tmp = build2 (GT_EXPR, boolean_type_node, arg2,
-		convert (TREE_TYPE (arg2), integer_zero_node));
-  rrot = build3 (COND_EXPR, type, tmp, lrot, rrot);
+  tmp = fold (build2 (GT_EXPR, boolean_type_node, arg2,
+		      convert (TREE_TYPE (arg2), integer_zero_node)));
+  rrot = fold (build3 (COND_EXPR, type, tmp, lrot, rrot));
 
   /* Do nothing if shift == 0.  */
-  tmp = build2 (EQ_EXPR, boolean_type_node, arg2,
-		convert (TREE_TYPE (arg2), integer_zero_node));
-  se->expr = build3 (COND_EXPR, type, tmp, arg, rrot);
+  tmp = fold (build2 (EQ_EXPR, boolean_type_node, arg2,
+		      convert (TREE_TYPE (arg2), integer_zero_node)));
+  se->expr = fold (build3 (COND_EXPR, type, tmp, arg, rrot));
 }
 
 /* The length of a character string.  */
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index d6366a4..929a326 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2004-12-27  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* gfortran.dg/g77/f90-intrinsic-bit.f: New.
+
 2004-12-27  Mark Mitchell  <mark@codesourcery.com>
 
 	PR c++/19148
diff --git a/gcc/testsuite/gfortran.dg/g77/f90-intrinsic-bit.f b/gcc/testsuite/gfortran.dg/g77/f90-intrinsic-bit.f
new file mode 100644
index 0000000..b718a4c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/f90-intrinsic-bit.f
@@ -0,0 +1,459 @@
+c { dg-do run }
+c  f90-intrinsic-bit.f
+c
+c Test Fortran 90 
+c  * intrinsic bit manipulation functions - Section 13.10.10
+c  * bitcopy subroutine - Section 13.9.3 
+c David Billinghurst <David.Billinghurst@riotinto.com>
+c
+c Notes: 
+c  * g77 only supports scalar arguments
+c  * third argument of ISHFTC is not optional in g77
+
+      logical fail
+      integer   i, i2, ia, i3
+      integer*2 j, j2, j3, ja
+      integer*1 k, k2, k3, ka
+      integer*8 m, m2, m3, ma
+
+      common /flags/ fail
+      fail = .false.
+
+c     BIT_SIZE - Section 13.13.16
+c     Determine BIT_SIZE by counting the bits 
+      ia = 0
+      i = 0
+      i = not(i)
+      do while ( (i.ne.0) .and. (ia.lt.127) ) 
+         ia = ia + 1
+         i = ishft(i,-1)
+      end do
+      call c_i(BIT_SIZE(i),ia,'BIT_SIZE(integer)')
+      ja = 0
+      j = 0
+      j = not(j)
+      do while  ( (j.ne.0) .and. (ja.lt.127) ) 
+         ja = ja + 1
+         j = ishft(j,-1)
+      end do
+      call c_i2(BIT_SIZE(j),ja,'BIT_SIZE(integer*2)')
+      ka = 0
+      k = 0
+      k = not(k)
+      do while ( (k.ne.0) .and. (ka.lt.127) )
+         ka = ka + 1
+         k = ishft(k,-1)
+      end do
+      call c_i1(BIT_SIZE(k),ka,'BIT_SIZE(integer*1)')
+      ma = 0
+      m = 0
+      m = not(m)
+      do while ( (m.ne.0) .and. (ma.lt.127) )
+         ma = ma + 1
+         m = ishft(m,-1)
+      end do
+      call c_i8(BIT_SIZE(m),ma,'BIT_SIZE(integer*8)')
+
+c     BTEST  - Section 13.13.17
+      j  = 7
+      j2 = 3
+      k  = 7
+      k2 = 3
+      m  = 7
+      m2 = 3
+      call c_l(BTEST(7,3),.true.,'BTEST(integer,integer)')
+      call c_l(BTEST(7,j2),.true.,'BTEST(integer,integer*2)')
+      call c_l(BTEST(7,k2),.true.,'BTEST(integer,integer*1)')
+      call c_l(BTEST(7,m2),.true.,'BTEST(integer,integer*8)')
+      call c_l(BTEST(j,3),.true.,'BTEST(integer*2,integer)')
+      call c_l(BTEST(j,j2),.true.,'BTEST(integer*2,integer*2)')
+      call c_l(BTEST(j,k2),.true.,'BTEST(integer*2,integer*1)')
+      call c_l(BTEST(j,m2),.true.,'BTEST(integer*2,integer*8)')
+      call c_l(BTEST(k,3),.true.,'BTEST(integer*1,integer)')
+      call c_l(BTEST(k,j2),.true.,'BTEST(integer*1,integer*2)')
+      call c_l(BTEST(k,k2),.true.,'BTEST(integer*1,integer*1)')
+      call c_l(BTEST(k,m2),.true.,'BTEST(integer*1,integer*8)')
+      call c_l(BTEST(m,3),.true.,'BTEST(integer*8,integer)')
+      call c_l(BTEST(m,j2),.true.,'BTEST(integer*8,integer*2)')
+      call c_l(BTEST(m,k2),.true.,'BTEST(integer*8,integer*1)')
+      call c_l(BTEST(m,m2),.true.,'BTEST(integer*8,integer*8)')
+ 
+c     IAND   - Section 13.13.40
+      j  = 3
+      j2 = 1
+      ja = 1
+      k  = 3
+      k2 = 1
+      ka = 1
+      m  = 3
+      m2 = 1
+      ma = 1
+      call c_i(IAND(3,1),1,'IAND(integer,integer)')
+      call c_i2(IAND(j,j2),ja,'IAND(integer*2,integer*2)')
+      call c_i1(IAND(k,k2),ka,'IAND(integer*1,integer*1)')
+      call c_i8(IAND(m,m2),ma,'IAND(integer*8,integer*8)')
+
+
+c     IBCLR  - Section 13.13.41
+      j  = 14
+      j2 = 1
+      ja = 12
+      k  = 14
+      k2 = 1
+      ka = 12
+      m  = 14
+      m2 = 1
+      ma = 12
+      call c_i(IBCLR(14,1),12,'IBCLR(integer,integer)')
+      call c_i(IBCLR(14,j2),12,'IBCLR(integer,integer*2)')
+      call c_i(IBCLR(14,k2),12,'IBCLR(integer,integer*1)')
+      call c_i(IBCLR(14,m2),12,'IBCLR(integer,integer*8)')
+      call c_i2(IBCLR(j,1),ja,'IBCLR(integer*2,integer)')
+      call c_i2(IBCLR(j,j2),ja,'IBCLR(integer*2,integer*2)')
+      call c_i2(IBCLR(j,k2),ja,'IBCLR(integer*2,integer*1)')
+      call c_i2(IBCLR(j,m2),ja,'IBCLR(integer*2,integer*8)')
+      call c_i1(IBCLR(k,1),ka,'IBCLR(integer*1,integer)')
+      call c_i1(IBCLR(k,j2),ka,'IBCLR(integer*1,integer*2)')
+      call c_i1(IBCLR(k,k2),ka,'IBCLR(integer*1,integer*1)')
+      call c_i1(IBCLR(k,m2),ka,'IBCLR(integer*1,integer*8)')
+      call c_i8(IBCLR(m,1),ma,'IBCLR(integer*8,integer)')
+      call c_i8(IBCLR(m,j2),ma,'IBCLR(integer*8,integer*2)')
+      call c_i8(IBCLR(m,k2),ma,'IBCLR(integer*8,integer*1)')
+      call c_i8(IBCLR(m,m2),ma,'IBCLR(integer*8,integer*8)')
+
+c     IBSET  - Section 13.13.43
+      j  = 12
+      j2 = 1
+      ja = 14
+      k  = 12
+      k2 = 1
+      ka = 14
+      m  = 12
+      m2 = 1
+      ma = 14
+      call c_i(IBSET(12,1),14,'IBSET(integer,integer)')
+      call c_i(IBSET(12,j2),14,'IBSET(integer,integer*2)')
+      call c_i(IBSET(12,k2),14,'IBSET(integer,integer*1)')
+      call c_i(IBSET(12,m2),14,'IBSET(integer,integer*8)')
+      call c_i2(IBSET(j,1),ja,'IBSET(integer*2,integer)')
+      call c_i2(IBSET(j,j2),ja,'IBSET(integer*2,integer*2)')
+      call c_i2(IBSET(j,k2),ja,'IBSET(integer*2,integer*1)')
+      call c_i2(IBSET(j,m2),ja,'IBSET(integer*2,integer*8)')
+      call c_i1(IBSET(k,1),ka,'IBSET(integer*1,integer)')
+      call c_i1(IBSET(k,j2),ka,'IBSET(integer*1,integer*2)')
+      call c_i1(IBSET(k,k2),ka,'IBSET(integer*1,integer*1)')
+      call c_i1(IBSET(k,m2),ka,'IBSET(integer*1,integer*8)')
+      call c_i8(IBSET(m,1),ma,'IBSET(integer*8,integer)')
+      call c_i8(IBSET(m,j2),ma,'IBSET(integer*8,integer*2)')
+      call c_i8(IBSET(m,k2),ma,'IBSET(integer*8,integer*1)')
+      call c_i8(IBSET(m,m2),ma,'IBSET(integer*8,integer*8)')
+
+c     IEOR   - Section 13.13.45
+      j  = 3
+      j2 = 1
+      ja = 2
+      k  = 3
+      k2 = 1
+      ka = 2
+      m  = 3
+      m2 = 1
+      ma = 2
+      call c_i(IEOR(3,1),2,'IEOR(integer,integer)')
+      call c_i2(IEOR(j,j2),ja,'IEOR(integer*2,integer*2)')
+      call c_i1(IEOR(k,k2),ka,'IEOR(integer*1,integer*1)')
+      call c_i8(IEOR(m,m2),ma,'IEOR(integer*8,integer*8)')
+
+c     ISHFT  - Section 13.13.49
+      i  = 3
+      i2 = 1
+      i3 = 0
+      ia = 6
+      j  = 3
+      j2 = 1
+      j3 = 0
+      ja = 6
+      k  = 3
+      k2 = 1
+      k3 = 0
+      ka = 6
+      m  = 3
+      m2 = 1
+      m3 = 0
+      ma = 6
+      call c_i(ISHFT(i,i2),ia,'ISHFT(integer,integer)')
+      call c_i(ISHFT(i,BIT_SIZE(i)),i3,'ISHFT(integer,integer) 2')
+      call c_i(ISHFT(i,-BIT_SIZE(i)),i3,'ISHFT(integer,integer) 3')
+      call c_i(ISHFT(i,0),i,'ISHFT(integer,integer) 4')
+      call c_i2(ISHFT(j,j2),ja,'ISHFT(integer*2,integer*2)')
+      call c_i2(ISHFT(j,BIT_SIZE(j)),j3,
+     $     'ISHFT(integer*2,integer*2) 2')
+      call c_i2(ISHFT(j,-BIT_SIZE(j)),j3,
+     $     'ISHFT(integer*2,integer*2) 3')
+      call c_i2(ISHFT(j,0),j,'ISHFT(integer*2,integer*2) 4')
+      call c_i1(ISHFT(k,k2),ka,'ISHFT(integer*1,integer*1)')
+      call c_i1(ISHFT(k,BIT_SIZE(k)),k3,
+     $     'ISHFT(integer*1,integer*1) 2')
+      call c_i1(ISHFT(k,-BIT_SIZE(k)),k3,
+     $     'ISHFT(integer*1,integer*1) 3')
+      call c_i1(ISHFT(k,0),k,'ISHFT(integer*1,integer*1) 4')
+      call c_i8(ISHFT(m,m2),ma,'ISHFT(integer*8,integer*8)')
+      call c_i8(ISHFT(m,BIT_SIZE(m)),m3,
+     $     'ISHFT(integer*8,integer*8) 2')
+      call c_i8(ISHFT(m,-BIT_SIZE(m)),m3,
+     $     'ISHFT(integer*8,integer*8) 3')
+      call c_i8(ISHFT(m,0),m,'ISHFT(integer*8,integer*8) 4')
+
+c     ISHFTC - Section 13.13.50
+c     The third argument is not optional in g77
+      i  = 3
+      i2 = 2
+      i3 = 3
+      ia = 5
+      j  = 3
+      j2 = 2
+      j3 = 3
+      ja = 5
+      k  = 3
+      k2 = 2
+      k3 = 3
+      ka = 5
+      m2 = 2
+      m3 = 3
+      ma = 5
+c     test all the combinations of arguments
+      call c_i(ISHFTC(i,i2,i3),5,'ISHFTC(integer,integer,integer)')
+      call c_i(ISHFTC(i,i2,j3),5,'ISHFTC(integer,integer,integer*2)')
+      call c_i(ISHFTC(i,i2,k3),5,'ISHFTC(integer,integer,integer*1)')
+      call c_i(ISHFTC(i,i2,m3),5,'ISHFTC(integer,integer,integer*8)')
+      call c_i(ISHFTC(i,j2,i3),5,'ISHFTC(integer,integer*2,integer)')
+      call c_i(ISHFTC(i,j2,j3),5,'ISHFTC(integer,integer*2,integer*2)')
+      call c_i(ISHFTC(i,j2,k3),5,'ISHFTC(integer,integer*2,integer*1)')
+      call c_i(ISHFTC(i,j2,m3),5,'ISHFTC(integer,integer*2,integer*8)')
+      call c_i(ISHFTC(i,k2,i3),5,'ISHFTC(integer,integer*1,integer)')
+      call c_i(ISHFTC(i,k2,j3),5,'ISHFTC(integer,integer*1,integer*2)')
+      call c_i(ISHFTC(i,k2,k3),5,'ISHFTC(integer,integer*1,integer*1)')
+      call c_i(ISHFTC(i,k2,m3),5,'ISHFTC(integer,integer*1,integer*8)')
+      call c_i(ISHFTC(i,m2,i3),5,'ISHFTC(integer,integer*8,integer)')
+      call c_i(ISHFTC(i,m2,j3),5,'ISHFTC(integer,integer*8,integer*2)')
+      call c_i(ISHFTC(i,m2,k3),5,'ISHFTC(integer,integer*8,integer*1)')
+      call c_i(ISHFTC(i,m2,m3),5,'ISHFTC(integer,integer*8,integer*8)')
+
+      call c_i2(ISHFTC(j,i2,i3),ja,'ISHFTC(integer*2,integer,integer)')
+      call c_i2(ISHFTC(j,i2,j3),ja,
+     $     'ISHFTC(integer*2,integer,integer*2)')
+      call c_i2(ISHFTC(j,i2,k3),ja,
+     $     'ISHFTC(integer*2,integer,integer*1)')
+      call c_i2(ISHFTC(j,i2,m3),ja,
+     $     'ISHFTC(integer*2,integer,integer*8)')
+      call c_i2(ISHFTC(j,j2,i3),ja,
+     $     'ISHFTC(integer*2,integer*2,integer)')
+      call c_i2(ISHFTC(j,j2,j3),ja,
+     $     'ISHFTC(integer*2,integer*2,integer*2)')
+      call c_i2(ISHFTC(j,j2,k3),ja,
+     $     'ISHFTC(integer*2,integer*2,integer*1)')
+      call c_i2(ISHFTC(j,j2,m3),ja,
+     $     'ISHFTC(integer*2,integer*2,integer*8)')
+      call c_i2(ISHFTC(j,k2,i3),ja,
+     $     'ISHFTC(integer*2,integer*1,integer)')
+      call c_i2(ISHFTC(j,k2,j3),ja,
+     $     'ISHFTC(integer*2,integer*1,integer*2)')
+      call c_i2(ISHFTC(j,k2,k3),ja,
+     $     'ISHFTC(integer*2,integer*1,integer*1)')
+      call c_i2(ISHFTC(j,k2,m3),ja,
+     $     'ISHFTC(integer*2,integer*1,integer*8)')
+      call c_i2(ISHFTC(j,m2,i3),ja,
+     $     'ISHFTC(integer*2,integer*8,integer)')
+      call c_i2(ISHFTC(j,m2,j3),ja,
+     $     'ISHFTC(integer*2,integer*8,integer*2)')
+      call c_i2(ISHFTC(j,m2,k3),ja,
+     $     'ISHFTC(integer*2,integer*8,integer*1)')
+      call c_i2(ISHFTC(j,m2,m3),ja,
+     $     'ISHFTC(integer*2,integer*8,integer*8)')
+
+      call c_i1(ISHFTC(k,i2,i3),ka,'ISHFTC(integer*1,integer,integer)')
+      call c_i1(ISHFTC(k,i2,j3),ka,
+     $     'ISHFTC(integer*1,integer,integer*2)')
+      call c_i1(ISHFTC(k,i2,k3),ka,
+     $     'ISHFTC(integer*1,integer,integer*1)')
+      call c_i1(ISHFTC(k,i2,m3),ka,
+     $     'ISHFTC(integer*1,integer,integer*8)')
+      call c_i1(ISHFTC(k,j2,i3),ka,
+     $     'ISHFTC(integer*1,integer*2,integer)')
+      call c_i1(ISHFTC(k,j2,j3),ka,
+     $     'ISHFTC(integer*1,integer*2,integer*2)')
+      call c_i1(ISHFTC(k,j2,k3),ka,
+     $     'ISHFTC(integer*1,integer*2,integer*1)')
+      call c_i1(ISHFTC(k,j2,m3),ka,
+     $     'ISHFTC(integer*1,integer*2,integer*8)')
+      call c_i1(ISHFTC(k,k2,i3),ka,
+     $     'ISHFTC(integer*1,integer*1,integer)')
+      call c_i1(ISHFTC(k,k2,j3),ka,
+     $     'ISHFTC(integer*1,integer*1,integer*2)')
+      call c_i1(ISHFTC(k,k2,k3),ka,
+     $     'ISHFTC(integer*1,integer*1,integer*1)')
+      call c_i1(ISHFTC(k,k2,m3),ka,
+     $     'ISHFTC(integer*1,integer*1,integer*8)')
+      call c_i1(ISHFTC(k,m2,i3),ka,
+     $     'ISHFTC(integer*1,integer*8,integer)')
+      call c_i1(ISHFTC(k,m2,j3),ka,
+     $     'ISHFTC(integer*1,integer*8,integer*2)')
+      call c_i1(ISHFTC(k,m2,k3),ka,
+     $     'ISHFTC(integer*1,integer*8,integer*1)')
+      call c_i1(ISHFTC(k,m2,m3),ka,
+     $     'ISHFTC(integer*1,integer*8,integer*8)')
+
+      call c_i8(ISHFTC(m,i2,i3),ma,'ISHFTC(integer*8,integer,integer)')
+      call c_i8(ISHFTC(m,i2,j3),ma,
+     $     'ISHFTC(integer*8,integer,integer*2)')
+      call c_i8(ISHFTC(m,i2,k3),ma,
+     $     'ISHFTC(integer*8,integer,integer*1)')
+      call c_i8(ISHFTC(m,i2,m3),ma,
+     $     'ISHFTC(integer*8,integer,integer*8)')
+      call c_i8(ISHFTC(m,j2,i3),ma,
+     $     'ISHFTC(integer*8,integer*2,integer)')
+      call c_i8(ISHFTC(m,j2,j3),ma,
+     $     'ISHFTC(integer*8,integer*2,integer*2)')
+      call c_i8(ISHFTC(m,j2,k3),ma,
+     $     'ISHFTC(integer*8,integer*2,integer*1)')
+      call c_i8(ISHFTC(m,j2,m3),ma,
+     $     'ISHFTC(integer*8,integer*2,integer*8)')
+      call c_i8(ISHFTC(m,k2,i3),ma,
+     $     'ISHFTC(integer*8,integer*1,integer)')
+      call c_i8(ISHFTC(m,k2,j3),ma,
+     $     'ISHFTC(integer*1,integer*8,integer*2)')
+      call c_i8(ISHFTC(m,k2,k3),ma,
+     $     'ISHFTC(integer*1,integer*8,integer*1)')
+      call c_i8(ISHFTC(m,k2,m3),ma,
+     $     'ISHFTC(integer*1,integer*8,integer*8)')
+      call c_i8(ISHFTC(m,m2,i3),ma,
+     $     'ISHFTC(integer*8,integer*8,integer)')
+      call c_i8(ISHFTC(m,m2,j3),ma,
+     $     'ISHFTC(integer*8,integer*8,integer*2)')
+      call c_i8(ISHFTC(m,m2,k3),ma,
+     $     'ISHFTC(integer*8,integer*8,integer*1)')
+      call c_i8(ISHFTC(m,m2,m3),ma,
+     $     'ISHFTC(integer*8,integer*8,integer*8)')
+
+c     test the corner cases
+      call c_i(ISHFTC(i,BIT_SIZE(i),BIT_SIZE(i)),i,
+     $     'ISHFTC(i,BIT_SIZE(i),BIT_SIZE(i)) i = integer')
+      call c_i(ISHFTC(i,0,BIT_SIZE(i)),i,
+     $     'ISHFTC(i,0,BIT_SIZE(i)) i = integer')
+      call c_i(ISHFTC(i,-BIT_SIZE(i),BIT_SIZE(i)),i,
+     $     'ISHFTC(i,-BIT_SIZE(i),BIT_SIZE(i)) i = integer')
+      call c_i2(ISHFTC(j,BIT_SIZE(j),BIT_SIZE(j)),j,
+     $     'ISHFTC(j,BIT_SIZE(j),BIT_SIZE(j)) j = integer*2')
+      call c_i2(ISHFTC(j,0,BIT_SIZE(j)),j,
+     $     'ISHFTC(j,0,BIT_SIZE(j)) j = integer*2')
+      call c_i2(ISHFTC(j,-BIT_SIZE(j),BIT_SIZE(j)),j,
+     $     'ISHFTC(j,-BIT_SIZE(j),BIT_SIZE(j)) j = integer*2')
+      call c_i1(ISHFTC(k,BIT_SIZE(k),BIT_SIZE(k)),k,
+     $     'ISHFTC(k,BIT_SIZE(k),BIT_SIZE(k)) k = integer*1')
+      call c_i1(ISHFTC(k,0,BIT_SIZE(k)),k,
+     $     'ISHFTC(k,0,BIT_SIZE(k)) k = integer*1')
+      call c_i1(ISHFTC(k,-BIT_SIZE(k),BIT_SIZE(k)),k,
+     $     'ISHFTC(k,-BIT_SIZE(k),BIT_SIZE(k)) k = integer*1')
+      call c_i8(ISHFTC(m,BIT_SIZE(m),BIT_SIZE(m)),m,
+     $     'ISHFTC(m,BIT_SIZE(m),BIT_SIZE(m)) m = integer*8')
+      call c_i8(ISHFTC(m,0,BIT_SIZE(m)),m,
+     $     'ISHFTC(m,0,BIT_SIZE(m)) m = integer*8')
+      call c_i8(ISHFTC(m,-BIT_SIZE(m),BIT_SIZE(m)),m,
+     $     'ISHFTC(m,-BIT_SIZE(m),BIT_SIZE(m)) m = integer*8')
+
+c     MVBITS - Section 13.13.74
+      i = 6
+      call MVBITS(7,2,2,i,0)
+      call c_i(i,5,'MVBITS 1')
+      j = 6
+      j2 = 7
+      ja = 5
+      call MVBITS(j2,2,2,j,0)
+      call c_i2(j,ja,'MVBITS 2')
+      k = 6
+      k2 = 7
+      ka = 5
+      call MVBITS(k2,2,2,k,0)
+      call c_i1(k,ka,'MVBITS 3')
+      m = 6
+      m2 = 7
+      ma = 5
+      call MVBITS(m2,2,2,m,0)
+      call c_i8(m,ma,'MVBITS 4')
+
+c     NOT    - Section 13.13.77
+c     Rather than assume integer sizes, mask off high bits
+      j  = 21
+      j2 = 31
+      ja = 10
+      k  = 21
+      k2 = 31
+      ka = 10
+      m  = 21
+      m2 = 31
+      ma = 10
+      call c_i(IAND(NOT(21),31),10,'NOT(integer)')
+      call c_i2(IAND(NOT(j),j2),ja,'NOT(integer*2)')
+      call c_i1(IAND(NOT(k),k2),ka,'NOT(integer*1)')
+      call c_i8(IAND(NOT(m),m2),ma,'NOT(integer*8)')
+
+      if ( fail ) call abort()
+      end
+
+      subroutine failure(label)
+c     Report failure and set flag
+      character*(*) label
+      logical fail
+      common /flags/ fail
+      write(6,'(a,a,a)') 'Test ',label,' FAILED'
+      fail = .true.
+      end
+
+      subroutine c_l(i,j,label)
+c     Check if LOGICAL i equals j, and fail otherwise
+      logical i,j
+      character*(*) label
+      if ( i .eqv. j ) then
+         call failure(label)
+         write(6,*) 'Got ',i,' expected ', j
+      end if
+      end
+
+      subroutine c_i(i,j,label)
+c     Check if INTEGER i equals j, and fail otherwise
+      integer i,j
+      character*(*) label
+      if ( i .ne. j ) then
+         call failure(label)
+         write(6,*) 'Got ',i,' expected ', j
+      end if
+      end
+
+      subroutine c_i2(i,j,label)
+c     Check if INTEGER*2 i equals j, and fail otherwise
+      integer*2 i,j
+      character*(*) label
+      if ( i .ne. j ) then
+         call failure(label)
+         write(6,*) 'Got ',i,' expected ', j
+      end if
+      end
+
+      subroutine c_i1(i,j,label)
+c     Check if INTEGER*1 i equals j, and fail otherwise
+      integer*1 i,j
+      character*(*) label
+      if ( i .ne. j ) then
+         call failure(label)
+         write(6,*) 'Got ',i,' expected ', j
+      end if
+      end
+
+      subroutine c_i8(i,j,label)
+c     Check if INTEGER*8 i equals j, and fail otherwise
+      integer*8 i,j
+      character*(*) label
+      if ( i .ne. j ) then
+         call failure(label)
+         write(6,*) 'Got ',i,' expected ', j
+      end if
+      end
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 749f5a3..8b1b53a 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,12 @@
+2004-12-27  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* libgfortran/libgfortran.h (GFC_UINTEGER_1, GFC_UINTEGER_2): 
+	Define.
+	* intrinsics/ishftc.c: Update copyright years.
+	(ishftc8): Change 'shift' and 'size' to GFC_INTEGER_4.
+	* intrinsics/mvbits.c: Correcty non-ASCII character in my name.
+	Add implementations for GFC_INTEGER_1 and GFC_INTEGER_2.
+
 2004-12-23  Bud Davis  <bdavis9659@comcast.net>
 
 	PR fortran/19071
diff --git a/libgfortran/intrinsics/ishftc.c b/libgfortran/intrinsics/ishftc.c
index 7d5767c..896faac 100644
--- a/libgfortran/intrinsics/ishftc.c
+++ b/libgfortran/intrinsics/ishftc.c
@@ -1,5 +1,5 @@
 /* Implementation of ishftc intrinsic.
-   Copyright 2002 Free Software Foundation, Inc.
+   Copyright 2002, 2004 Free Software Foundation, Inc.
    Contributed by Paul Brook <paul@nowt.org>
 
 This file is part of the GNU Fortran 95 runtime library (libgfor).
@@ -41,11 +41,11 @@ ishftc4 (GFC_INTEGER_4 i, GFC_INTEGER_4 shift, GFC_INTEGER_4 size)
   return (i & mask) | (bits >> (size - shift)) | ((i << shift) & ~mask);
 }
 
-extern GFC_INTEGER_8 ishftc8 (GFC_INTEGER_8, GFC_INTEGER_8, GFC_INTEGER_8);
+extern GFC_INTEGER_8 ishftc8 (GFC_INTEGER_8, GFC_INTEGER_4, GFC_INTEGER_4);
 export_proto(ishftc8);
 
 GFC_INTEGER_8
-ishftc8 (GFC_INTEGER_8 i, GFC_INTEGER_8 shift, GFC_INTEGER_8 size)
+ishftc8 (GFC_INTEGER_8 i, GFC_INTEGER_4 shift, GFC_INTEGER_4 size)
 {
   GFC_INTEGER_8 mask;
   GFC_UINTEGER_8 bits;
diff --git a/libgfortran/intrinsics/mvbits.c b/libgfortran/intrinsics/mvbits.c
index 140547b..e1e3e40 100644
--- a/libgfortran/intrinsics/mvbits.c
+++ b/libgfortran/intrinsics/mvbits.c
@@ -1,6 +1,6 @@
 /* Implementation of the MVBITS intrinsic
    Copyright (C) 2004 Free Software Foundation, Inc.
-   Contributed by Tobias Schlüter
+   Contributed by Tobias Schlüter
 
 This file is part of the GNU Fortran 95 runtime library (libgfortran).
 
@@ -48,6 +48,22 @@ SUB_NAME (const TYPE *from, const GFC_INTEGER_4 *frompos,
 #endif
 
 #ifndef SUB_NAME
+#  define TYPE GFC_INTEGER_1
+#  define UTYPE GFC_UINTEGER_1
+#  define SUB_NAME mvbits_i1
+#  include "mvbits.c"
+#  undef SUB_NAME
+#  undef TYPE
+#  undef UTYPE
+ 
+#  define TYPE GFC_INTEGER_2
+#  define UTYPE GFC_UINTEGER_2
+#  define SUB_NAME mvbits_i2
+#  include "mvbits.c"
+#  undef SUB_NAME
+#  undef TYPE
+#  undef UTYPE
+ 
 #  define TYPE GFC_INTEGER_4
 #  define UTYPE GFC_UINTEGER_4
 #  define SUB_NAME mvbits_i4
diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h
index 06a68c6..7ddc0ed 100644
--- a/libgfortran/libgfortran.h
+++ b/libgfortran/libgfortran.h
@@ -189,6 +189,8 @@ typedef int8_t GFC_INTEGER_1;
 typedef int16_t GFC_INTEGER_2;
 typedef int32_t GFC_INTEGER_4;
 typedef int64_t GFC_INTEGER_8;
+typedef uint8_t GFC_UINTEGER_1;
+typedef uint16_t GFC_UINTEGER_2;
 typedef uint32_t GFC_UINTEGER_4;
 typedef uint64_t GFC_UINTEGER_8;
 typedef GFC_INTEGER_4 GFC_LOGICAL_4;