libf2c/libF77/qbitbits.c

   1 #include "f2c.h"
   2
   3 #ifndef LONGBITS
   4 #define LONGBITS 32
   5 #endif
   6
   7 #ifndef LONG8BITS
   8 #define LONG8BITS (2*LONGBITS)
   9 #endif
  10
  11 integer
  12 qbit_bits (longint a, integer b, integer len)
  13 {
  14   /* Assume 2's complement arithmetic */
  15
  16   ulongint x, y;
  17
  18   x = (ulongint) a;
  19   y = (ulongint) - 1L;
  20   x >>= b;
  21   y <<= len;
  22   return (longint) (x & y);
  23 }
  24
  25 longint
  26 qbit_cshift (longint a, integer b, integer len)
  27 {
  28   ulongint x, y, z;
  29
  30   x = (ulongint) a;
  31   if (len <= 0)
  32     {
  33       if (len == 0)
  34         return 0;
  35       goto full_len;
  36     }
  37   if (len >= LONG8BITS)
  38     {
  39     full_len:
  40       if (b >= 0)
  41         {
  42           b %= LONG8BITS;
  43           return (longint) (x << b | x >> (LONG8BITS - b));
  44         }
  45       b = -b;
  46       b %= LONG8BITS;
  47       return (longint) (x << (LONG8BITS - b) | x >> b);
  48     }
  49   y = z = (unsigned long) -1;
  50   y <<= len;
  51   z &= ~y;
  52   y &= x;
  53   x &= z;
  54   if (b >= 0)
  55     {
  56       b %= len;
  57       return (longint) (y | (z & (x << b | x >> (len - b))));
  58     }
  59   b = -b;
  60   b %= len;
  61   return (longint) (y | (z & (x >> b | x << (len - b))));
  62 }