libf2c/libF77/lbitbits.c

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