INTERCAL 0.13 release.
[intercal:intercal.git] / src / fiddle.c
1 /*
2  * fiddle.c -- functions that implement the five INTERCAL operators
3  *
4  * We link these to the compiler, too, in order to do constant folding
5  */
6
7 #include "fiddle.h"
8 #include "sizes.h"
9
10 unsigned int mingle(register unsigned int r, register unsigned int s)
11 {
12   if (Base == 2) {
13     r = ((r & 0x0000ff00) << 8) | (r & 0x000000ff);
14     r = ((r & 0x00f000f0) << 4) | (r & 0x000f000f);
15     r = ((r & 0x0c0c0c0c) << 2) | (r & 0x03030303);
16     r = ((r & 0x22222222) << 1) | (r & 0x11111111);
17     s = ((s & 0x0000ff00) << 8) | (s & 0x000000ff);
18     s = ((s & 0x00f000f0) << 4) | (s & 0x000f000f);
19     s = ((s & 0x0c0c0c0c) << 2) | (s & 0x03030303);
20     s = ((s & 0x22222222) << 1) | (s & 0x11111111);
21     return (r << 1) | s;
22   }
23   else {
24     unsigned int result = 0, fac = 1;
25     int i;
26     for (i = 0 ; i < Small_digits ; i++) {
27       result += fac * (s % Base);
28       s /= Base;
29       fac *= Base;
30       result += fac * (r % Base);
31       r /= Base;
32       fac *= Base;
33     }
34     return result;
35   }
36 }
37
38 unsigned int iselect(register unsigned int r, register unsigned int s)
39 {
40   if (Base == 2) {
41     register unsigned int i = 1, t = 0;
42     while (s) {
43       if (s & i) {
44         t |= r & i;
45         s ^= i;
46         i <<= 1;
47       }
48       else {
49         s >>= 1;
50         r >>= 1;
51       }
52     }
53     return(t);
54   }
55   else {
56     unsigned int j, result = 0, fac, digit, ofac = 1;
57     for (j = Base - 1 ; j > 0 ; j--) {
58       int i;
59       fac = 1;
60       for (i = 0; i < Large_digits ; i++) {
61         if ((s / fac) % Base == j) {
62           digit = (r / fac) % Base;
63           if (digit)
64             result += ofac * (digit > j ? digit : j);
65           ofac *= Base;
66         }
67         fac *= Base;
68       }
69     }
70     return result;
71   }
72 }
73
74 static unsigned int whirl(unsigned int len, unsigned int p, unsigned int n)
75 {
76   unsigned int i, fac = 1, result = 0, d1, d2, dsave;
77   d1 = n % Base;
78   dsave = d1;
79   for (i = 1 ; i <= len ; i++) {
80     d2 = d1;
81     d1 = (i < len) ? (n /= Base, n % Base) : dsave;
82     if (d1 <= p)
83       result += fac * ((d2 < d1 || d2 > p) ? d1 : d2);
84     else
85       result += fac * ((d2 < d1 && d2 > p) ? d1 : d2);
86     fac *= Base;
87   }
88   return result;
89 }
90
91 unsigned int and16(unsigned int n)
92 {
93   if (Base == 2) {
94     unsigned int m = (n >> 1);
95     if (n & 1)
96       m |= 0x8000;
97     return(m & n);
98   }
99   else {
100     return whirl(Small_digits,0,n);
101   }
102 }
103
104 unsigned int or16(unsigned int n)
105 {
106   if (Base == 2) {
107     unsigned int m = (n >> 1);
108     if (n & 1)
109       m |= 0x8000;
110     return(m | n);
111   }
112   else {
113     return whirl(Small_digits,Base-1,n);
114   }
115 }
116
117 unsigned int whirl16(unsigned int p, unsigned int n)
118 {
119   return whirl(Small_digits,p,n);
120 }
121
122 unsigned int and32(unsigned int n)
123 {
124   if (Base == 2) {
125     unsigned int m = (n >> 1);
126     if (n & 1)
127       m |= 0x80000000;
128     return(m & n);
129   }
130   else {
131     return whirl(Large_digits,0,n);
132   }
133 }
134
135 unsigned int or32(unsigned int n)
136 {
137   if (Base == 2) {
138     unsigned int m = (n >> 1);
139     if (n & 1)
140       m |= 0x80000000;
141     return(m | n);
142   }
143   else {
144     return whirl(Large_digits,Base-1,n);
145   }
146 }
147
148 unsigned int whirl32(unsigned int p, unsigned int n)
149 {
150   return whirl(Large_digits,p,n);
151 }
152
153 unsigned int xor(unsigned int len, unsigned int n)
154 {
155   unsigned int i, fac = 1, result = 0, d1, d2, dsave;
156   d1 = n % Base;
157   dsave = d1;
158   for (i = 1 ; i <= len ; i++) {
159     d2 = d1;
160     d1 = (i < len) ? (n /= Base, n % Base) : dsave;
161     result += fac * ((Base + d1 - d2) % Base);
162     fac *= Base;
163   }
164   return result;
165 }
166
167 unsigned int xor16(unsigned int n)
168 {
169   if (Base == 2) {
170     unsigned int m = (n >> 1);
171     if (n & 1)
172       m |= 0x8000;
173     return(m ^ n);
174   }
175   else {
176     return xor(Small_digits,n);
177   }
178 }
179
180 unsigned int xor32(unsigned int n)
181 {
182   if (Base == 2) {
183     unsigned int m = (n >> 1);
184     if (n & 1)
185       m |= 0x80000000;
186     return(m ^ n);
187   }
188   else {
189     return xor(Large_digits,n);
190   }
191 }
192
193 static unsigned int fin(unsigned int len, unsigned int n)
194 {
195   unsigned int i, fac = 1, result = 0, d1, d2, dsave;
196   d1 = n % Base;
197   dsave = d1;
198   for (i = 1 ; i <= len ; i++) {
199     d2 = d1;
200     d1 = (i < len) ? (n /= Base, n % Base) : dsave;
201     result += fac * ((d1 + d2) % Base);
202     fac *= Base;
203   }
204   return result;
205 }
206
207 unsigned int fin16(unsigned int n)
208 {
209   if (Base == 2) {
210     unsigned int m = (n >> 1);
211     if (n & 1)
212       m |= 0x8000;
213     return(m ^ n);
214   }
215   else {
216     return fin(Small_digits,n);
217   }
218 }
219
220 unsigned int fin32(unsigned int n)
221 {
222   if (Base == 2) {
223     unsigned int m = (n >> 1);
224     if (n & 1)
225       m |= 0x80000000;
226     return(m ^ n);
227   }
228   else {
229     return fin(Large_digits,n);
230   }
231 }
232
233 /* fiddle.c */