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 #ifdef KR_headers
  13 qbit_bits(a, b, len) longint a; integer b, len;
  14 #else
  15 qbit_bits(longint a, integer b, integer len)
  16 #endif
  17 {
  18         /* Assume 2's complement arithmetic */
  19
  20         ulongint x, y;
  21
  22         x = (ulongint) a;
  23         y = (ulongint)-1L;
  24         x >>= b;
  25         y <<= len;
  26         return (longint)(x & y);
  27         }
  28
  29  longint
  30 #ifdef KR_headers
  31 qbit_cshift(a, b, len) longint a; integer b, len;
  32 #else
  33 qbit_cshift(longint a, integer b, integer len)
  34 #endif
  35 {
  36         ulongint x, y, z;
  37
  38         x = (ulongint)a;
  39         if (len <= 0) {
  40                 if (len == 0)
  41                         return 0;
  42                 goto full_len;
  43                 }
  44         if (len >= LONG8BITS) {
  45  full_len:
  46                 if (b >= 0) {
  47                         b %= LONG8BITS;
  48                         return (longint)(x << b | x >> LONG8BITS - b );
  49                         }
  50                 b = -b;
  51                 b %= LONG8BITS;
  52                 return (longint)(x << LONG8BITS - b | x >> b);
  53                 }
  54         y = z = (unsigned long)-1;
  55         y <<= len;
  56         z &= ~y;
  57         y &= x;
  58         x &= z;
  59         if (b >= 0) {
  60                 b %= len;
  61                 return (longint)(y | z & (x << b | x >> len - b));
  62                 }
  63         b = -b;
  64         b %= len;
  65         return (longint)(y | z & (x >> b | x << len - b));
  66         }