Mercurial > repo

comparison interps/c-intercal/src/fiddle.c @ 996:859f9b4339e6

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
<Gregor> tar xf egobot.tar.xz
author HackBot
date Sun, 09 Dec 2012 19:30:08 +0000
parents
children
comparison
equal deleted inserted replaced
995:6883f5911eb7 996:859f9b4339e6
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 LICENSE TERMS
7 Copyright (C) 1996 Eric S. Raymond
8
9 This program is free software; you can redistribute it and/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation; either version 2 of the License, or
12 (at your option) any later version.
13
14 This program is distributed in the hope that it will be useful,
15 but WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 GNU General Public License for more details.
18
19 You should have received a copy of the GNU General Public License
20 along with this program; if not, write to the Free Software
21 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
22 */
23
24 #include "fiddle.h"
25 #include "sizes.h"
26 #include "ick_lose.h"
27 #include <stdio.h>
28
29 unsigned int ick_mingle(register unsigned int r, register unsigned int s)
30 {
31 if (ick_Base == 2) {
32 if (r>0xffff || s>0xffff)
33 ick_lose(IE533, ick_lineno, (const char *)NULL);
34 r = ((r & 0x0000ff00) << 8) | (r & 0x000000ff);
35 r = ((r & 0x00f000f0) << 4) | (r & 0x000f000f);
36 r = ((r & 0x0c0c0c0c) << 2) | (r & 0x03030303);
37 r = ((r & 0x22222222) << 1) | (r & 0x11111111);
38 s = ((s & 0x0000ff00) << 8) | (s & 0x000000ff);
39 s = ((s & 0x00f000f0) << 4) | (s & 0x000f000f);
40 s = ((s & 0x0c0c0c0c) << 2) | (s & 0x03030303);
41 s = ((s & 0x22222222) << 1) | (s & 0x11111111);
42 return (r << 1) | s;
43 }
44 else {
45 unsigned int result = 0, fac = 1;
46 int i;
47 for (i = 0 ; i < ick_Small_digits ; i++) {
48 result += fac * (s % ick_Base);
49 s /= ick_Base;
50 fac *= ick_Base;
51 result += fac * (r % ick_Base);
52 r /= ick_Base;
53 fac *= ick_Base;
54 }
55 return result;
56 }
57 }
58
59 unsigned int ick_iselect(register unsigned int r, register unsigned int s)
60 {
61 if (ick_Base == 2) {
62 register unsigned int i = 1, t = 0;
63 while (s) {
64 if (s & i) {
65 t |= r & i;
66 s ^= i;
67 i <<= 1;
68 }
69 else {
70 s >>= 1;
71 r >>= 1;
72 }
73 }
74 return(t);
75 }
76 else {
77 unsigned int j, result = 0, fac, digit, ofac = 1;
78 for (j = (unsigned)ick_Base - 1 ; j > 0 ; j--) {
79 int i;
80 fac = 1;
81 for (i = 0; i < ick_Large_digits ; i++) {
82 if ((s / fac) % ick_Base == j) {
83 digit = (r / fac) % ick_Base;
84 if (digit)
85 result += ofac * (digit > j ? digit : j);
86 ofac *= ick_Base;
87 }
88 fac *= ick_Base;
89 }
90 }
91 return result;
92 }
93 }
94
95 static unsigned int ick_whirl(unsigned int len, unsigned int p, unsigned int n)
96 {
97 unsigned int i, fac = 1, result = 0, d1, d2, dsave;
98 d1 = n % ick_Base;
99 dsave = d1;
100 for (i = 1 ; i <= len ; i++) {
101 d2 = d1;
102 d1 = (i < len) ? (n /= ick_Base, n % ick_Base) : dsave;
103 if (d1 <= p)
104 result += fac * ((d2 < d1 || d2 > p) ? d1 : d2);
105 else
106 result += fac * ((d2 < d1 && d2 > p) ? d1 : d2);
107 fac *= ick_Base;
108 }
109 return result;
110 }
111
112 unsigned int ick_and16(unsigned int n)
113 {
114 if (ick_Base == 2) {
115 unsigned int m = (n >> 1);
116 if (n & 1)
117 m |= 0x8000;
118 return(m & n);
119 }
120 else {
121 return ick_whirl((unsigned)ick_Small_digits,0,n);
122 }
123 }
124
125 unsigned int ick_or16(unsigned int n)
126 {
127 if (ick_Base == 2) {
128 unsigned int m = (n >> 1);
129 if (n & 1)
130 m |= 0x8000;
131 return(m | n);
132 }
133 else {
134 return ick_whirl((unsigned)ick_Small_digits,(unsigned)ick_Base-1,n);
135 }
136 }
137
138 unsigned int ick_whirl16(unsigned int p, unsigned int n)
139 {
140 return ick_whirl((unsigned)ick_Small_digits,p,n);
141 }
142
143 unsigned int ick_and32(unsigned int n)
144 {
145 if (ick_Base == 2) {
146 unsigned int m = (n >> 1);
147 if (n & 1)
148 m |= 0x80000000;
149 return(m & n);
150 }
151 else {
152 return ick_whirl((unsigned)ick_Large_digits,0,n);
153 }
154 }
155
156 unsigned int ick_or32(unsigned int n)
157 {
158 if (ick_Base == 2) {
159 unsigned int m = (n >> 1);
160 if (n & 1)
161 m |= 0x80000000;
162 return(m | n);
163 }
164 else {
165 return ick_whirl((unsigned)ick_Large_digits,(unsigned)ick_Base-1,n);
166 }
167 }
168
169 unsigned int ick_whirl32(unsigned int p, unsigned int n)
170 {
171 return ick_whirl((unsigned)ick_Large_digits,p,n);
172 }
173
174 static unsigned int ick_xor(unsigned int len, unsigned int n)
175 {
176 unsigned int i, fac = 1, result = 0, d1, d2, dsave;
177 d1 = n % ick_Base;
178 dsave = d1;
179 for (i = 1 ; i <= len ; i++) {
180 d2 = d1;
181 d1 = (i < len) ? (n /= ick_Base, n % ick_Base) : dsave;
182 result += fac * ((ick_Base + d1 - d2) % ick_Base);
183 fac *= ick_Base;
184 }
185 return result;
186 }
187
188 unsigned int ick_xor16(unsigned int n)
189 {
190 if (ick_Base == 2) {
191 unsigned int m = (n >> 1);
192 if (n & 1)
193 m |= 0x8000;
194 return(m ^ n);
195 }
196 else {
197 return ick_xor((unsigned)ick_Small_digits,n);
198 }
199 }
200
201 unsigned int ick_xor32(unsigned int n)
202 {
203 if (ick_Base == 2) {
204 unsigned int m = (n >> 1);
205 if (n & 1)
206 m |= 0x80000000;
207 return(m ^ n);
208 }
209 else {
210 return ick_xor((unsigned)ick_Large_digits,n);
211 }
212 }
213
214 static unsigned int ick_fin(unsigned int len, unsigned int n)
215 {
216 unsigned int i, fac = 1, result = 0, d1, d2, dsave;
217 d1 = n % ick_Base;
218 dsave = d1;
219 for (i = 1 ; i <= len ; i++) {
220 d2 = d1;
221 d1 = (i < len) ? (n /= ick_Base, n % ick_Base) : dsave;
222 result += fac * ((d1 + d2) % ick_Base);
223 fac *= ick_Base;
224 }
225 return result;
226 }
227
228 unsigned int ick_fin16(unsigned int n)
229 {
230 if (ick_Base == 2) {
231 unsigned int m = (n >> 1);
232 if (n & 1)
233 m |= 0x8000;
234 return(m ^ n);
235 }
236 else {
237 return ick_fin((unsigned)ick_Small_digits,n);
238 }
239 }
240
241 unsigned int ick_fin32(unsigned int n)
242 {
243 if (ick_Base == 2) {
244 unsigned int m = (n >> 1);
245 if (n & 1)
246 m |= 0x80000000;
247 return(m ^ n);
248 }
249 else {
250 return ick_fin((unsigned)ick_Large_digits,n);
251 }
252 }
253
254 /* AIS: Reversed operations, for operand overloading */
255
256 static unsigned int ick_rotleft16(unsigned int n)
257 {
258 return !!(n&0x8000)|((n&0x7FFF)<<1);
259 }
260 static unsigned int ick_rotleft32(unsigned int n)
261 {
262 return !!(n&0x80000000)|((n&0x7FFFFFFF)<<1);
263 }
264
265 /* For the time being, just work out the answer in binary, and test using
266 the base-whatever operation. This means that there'll nearly always be
267 a failure in reversing in bases other than 2. */
268 unsigned int ick_rev_or16(unsigned int n)
269 {
270 if(ick_or16(ick_rotleft16(ick_and16(n)))==n) return ick_rotleft16(ick_and16(n));
271 ick_lose(IE277, ick_lineno, (const char*) NULL);
272 /*@-unreachable@*/ return 0; /*@=unreachable@*/
273 }
274
275 unsigned int ick_rev_or32(unsigned int n)
276 {
277 if(ick_or32(ick_rotleft32(ick_and32(n)))==n) return ick_rotleft32(ick_and32(n));
278 ick_lose(IE277, ick_lineno, (const char*) NULL);
279 /*@-unreachable@*/ return 0; /*@=unreachable@*/
280 }
281
282 unsigned int ick_rev_and16(unsigned int n)
283 {
284 if(ick_and16(ick_rotleft16(ick_or16(n)))==n) return ick_rotleft16(ick_or16(n));
285 ick_lose(IE277, ick_lineno, (const char*) NULL);
286 /*@-unreachable@*/ return 0; /*@=unreachable@*/
287 }
288
289 unsigned int ick_rev_and32(unsigned int n)
290 {
291 if(ick_and32(ick_rotleft32(ick_or32(n)))==n) return ick_rotleft32(ick_or32(n));
292 ick_lose(IE277, ick_lineno, (const char*) NULL);
293 /*@-unreachable@*/ return 0; /*@=unreachable@*/
294 }
295
296 unsigned int ick_rev_xor16(unsigned int n)
297 {
298 unsigned int a=0, l=1, t=0;
299 while(l<=0x4000)
300 {
301 if(n&l)
302 t^=1;
303 if(t)
304 a+=l*2;
305 l*=2;
306 }
307 if(ick_xor16(a)==n) return a;
308 ick_lose(IE277, ick_lineno, (const char*) NULL);
309 /*@-unreachable@*/ return 0; /*@=unreachable@*/
310 }
311
312
313 unsigned int ick_rev_xor32(unsigned int n)
314 {
315 unsigned int a=0, l=1, t=0;
316 while(l<=0x4000000)
317 {
318 if(n&l)
319 t^=1;
320 if(t)
321 a+=l*2;
322 l*=2;
323 }
324 if(ick_xor32(a)==n) return a;
325 ick_lose(IE277, ick_lineno, (const char*) NULL);
326 /*@-unreachable@*/ return 0; /*@=unreachable@*/
327 }
328
329 unsigned int ick_rev_fin16(unsigned int n)
330 {
331 unsigned int a=0, l=1, t=0;
332 while(l<=0x4000)
333 {
334 if(n&l)
335 t^=1;
336 if(t)
337 a+=l*2;
338 l*=2;
339 }
340 if(ick_fin16(a)==n) return a;
341 ick_lose(IE277, ick_lineno, (const char*) NULL);
342 /*@-unreachable@*/ return 0; /*@=unreachable@*/
343 }
344
345
346 unsigned int ick_rev_fin32(unsigned int n)
347 {
348 unsigned int a=0, l=1, t=0;
349 while(l<=0x4000000)
350 {
351 if(n&l)
352 t^=1;
353 if(t)
354 a+=l*2;
355 l*=2;
356 }
357 if(ick_fin32(a)==n) return a;
358 ick_lose(IE277, ick_lineno, (const char*) NULL);
359 /*@-unreachable@*/ return 0; /*@=unreachable@*/
360 }
361
362 unsigned int ick_rev_whirl16(unsigned int p, unsigned int n)
363 {
364 /* Only reverse if all digits are the same. */
365 if(ick_whirl16(p,n)==n) return n;
366 ick_lose(IE277, ick_lineno, (const char*) NULL);
367 /*@-unreachable@*/ return 0; /*@=unreachable@*/
368 }
369
370 unsigned int ick_rev_whirl32(unsigned int p, unsigned int n)
371 {
372 /* Only reverse if all digits are the same. */
373 if(ick_whirl32(p,n)==n) return n;
374 ick_lose(IE277, ick_lineno, (const char*) NULL);
375 /*@-unreachable@*/ return 0; /*@=unreachable@*/
376 }
377
378 /* AIS: Some helper functions for the optimizer, only working in base 2 */
379
380 unsigned int ick_xselx(unsigned int x)
381 {
382 register unsigned int r=0;
383 if(ick_Base != 2) ick_lose(IE778, ick_lineno, (const char*) NULL);
384 while(x) {if(x&1) r=(r<<1)|1; x>>=1;}
385 return r;
386 }
387
388 unsigned int ick_setbitcount(unsigned int x)
389 {
390 register unsigned int r=0;
391 while(x) {if(x&1) r++; x>>=1;}
392 return r;
393 }
394
395 unsigned int ick_smudgeright(unsigned int x)
396 {
397 x=x|(x>>1);
398 x=x|(x>>2);
399 x=x|(x>>4);
400 x=x|(x>>8);
401 x=x|(x>>18);
402 return x;
403 }
404
405 unsigned int ick_smudgeleft(unsigned int x)
406 {
407 x=x|(x<<1);
408 x=x|(x<<2);
409 x=x|(x<<4);
410 x=x|(x<<8);
411 x=x|(x<<18);
412 return x;
413 }
414
415 /* fiddle.c */