Last change
on this file was 2, checked in by bird, 22 years ago |
Initial revision
|
-
Property cvs2svn:cvs-rev
set to
1.1
-
Property svn:eol-style
set to
native
-
Property svn:executable
set to
*
|
File size:
1.1 KB
|
Line | |
---|
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 | }
|
---|
Note:
See
TracBrowser
for help on using the repository browser.