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.0 KB
|
Line | |
---|
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 | }
|
---|
Note:
See
TracBrowser
for help on using the repository browser.