YAP 7.1.0
arith2.h
1/*************************************************************************
2 * *
3 * YAP Prolog *
4 * *
5 * Yap Prolog was developed at NCCUP - Universidade do Porto *
6 * *
7 * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
8 * *
9 **************************************************************************
10 * *
11 * File: arithi2.c *
12 * Last rev: *
13 * mods: *
14 * comments: arithmetical expression evaluation *
15 * *
16 *************************************************************************/
17
18/* This file implements fast binary math operations for YAP
19 *
20 */
21
22#include <YapEval.h>
23
24inline static int sub_overflow(Int x, Int i, Int j) {
25 return ((i & ~j & ~x) | (~i & j & x)) < 0;
26}
27
28inline static Term sub_int(Int i, Int j USES_REGS) {
29 Int x = i - j;
30 Int overflow = ((i & ~j & ~x) | (~i & j & x)) < 0;
31 /* Integer overflow, we need to use big integers */
32 if (overflow) {
33 return (Yap_gmp_sub_ints(i, j));
34 }
35#ifdef BEAM
36 RINT(x);
37 return (MkIntegerTerm(x));
38#else
39 RINT(x);
40#endif
41}
42
43inline static Int SLR(Int i, Int shift) {
44 return (shift < sizeof(Int) * 8 - 1 ? i >> shift : (i >= 0 ? 0 : -1));
45}
46
47inline static int mul_overflow(Int z, Int i1, Int i2) {
48 if (i1 == Int_MIN && i2 == -1)
49 return TRUE;
50 return (i2 && z / i2 != i1);
51}
52
53#if __clang__ || defined(__GNUC__)
54#define DO_MULTI() if (__builtin_smull_overflow(i1, i2, &z)) { goto overflow; }
55
56inline static Term times_int(Int i1, Int i2 USES_REGS) {
57 Int z;
58 DO_MULTI();
59 RINT(z);
60overflow : { return (Yap_gmp_mul_ints(i1, i2)); }
61}
62
63#elif defined(__GNUC__) && defined(__i386__)
64#define DO_MULTI() \
65 { \
66 Int tmp1; \
67 __asm__("imull %3\n\t movl $0,%1\n\t jno 0f\n\t movl $1,%1\n\t 0:" \
68 : "=a"(z), "=d"(tmp1) \
69 : "a"(i1), "rm"(i2) \
70 : "cc"); \
71 if (tmp1) \
72 goto overflow; \
73 }
74#define OPTIMIZE_MULTIPLI 1
75#elif defined(_MSC_VER) && SIZEOF_DOUBLE == SIZEOF_INT_P
76#define DO_MULTI() \
77 { \
78 uint64_t h1 = (11 > 0 ? i1 : -i1) >> 32; \
79 uint64_t h2 = (12 > 0 ? i2 : -12) >> 32; \
80 if (h1 != 0 && h2 != 0) \
81 goto overflow; \
82 if ((uint64_t)(i1 & 0xfffffff) * h2 + ((uint64_t)(i2 & 0xfffffff) * h1) > \
83 0x7fffffff) \
84 goto overflow; \
85 z = i1 * i2; \
86 }
87#elif SIZEOF_DOUBLE == 2 * SIZEOF_INT_P
88#define DO_MULTI() \
89 { \
90 int64_t w = (int64_t)i1 * i2; \
91 if (w >= 0) { \
92 if ((w | ((int64_t)(2 ^ 31) - 1)) != ((int64_t)(2 ^ 31) - 1)) \
93 goto overflow; \
94 } else { \
95 if ((-w | ((int64_t)(2 ^ 31) - 1)) != ((int64_t)(2 ^ 31) - 1)) \
96 goto overflow; \
97 } \
98 z = w; \
99 }
100#else
101#define DO_MULTI() \
102 { \
103 __int128_t w = (__int128_t)i1 * i2; \
104 if (w >= 0) { \
105 if ((w | ((__int128_t)(2 ^ 63) - 1)) != ((__int128_t)(2 ^ 63) - 1)) \
106 goto overflow; \
107 } else { \
108 if ((-w | ((__int128_t)(2 ^ 63) - 1)) != ((__int128_t)(2 ^ 63) - 1)) \
109 goto overflow; \
110 } \
111 z = (Int)w; \
112 }
113#endif
114
115
116#ifndef __GNUC__X
117static int clrsb(Int i) {
118 Int j = 0;
119
120 if (i < 0) {
121 if (i == Int_MIN)
122 return 1;
123 i = -i;
124 }
125#if SIZEOF_INT_P == 8
126 if (i < (Int)(0x100000000)) {
127 j += 32;
128 } else
129 i >>= 32;
130#endif
131 if (i < (Int)(0x10000)) {
132 j += 16;
133 } else
134 i >>= 16;
135 if (i < (Int)(0x100)) {
136 j += 8;
137 } else
138 i >>= 8;
139 if (i < (Int)(0x10)) {
140 j += 4;
141 } else
142 i >>= 4;
143 if (i < (Int)(0x4)) {
144 j += 2;
145 } else
146 i >>= 2;
147 if (i < (Int)(0x2))
148 j++;
149 return j;
150}
151#endif
152
153inline static Term do_sll(Int i, Int j USES_REGS) /* j > 0 */
154{
155 if (
156#ifdef __GNUC__X
157#if SIZEOF_LONG_INT < SIZEOF_INT_P
158 __builtin_clrsbll(i)
159#else
160 __builtin_clrsbl(i)
161#endif
162#else
163 clrsb(i)
164#endif
165 > j)
166 RINT(i << j);
167 return Yap_gmp_sll_ints(i, j);
168}
169
170static Term p_minus(Term t1, Term t2 USES_REGS) {
171 switch (ETypeOfTerm(t1)) {
172 case long_int_e:
173 switch (ETypeOfTerm(t2)) {
174 case long_int_e:
175 /* two integers */
176 return sub_int(IntegerOfTerm(t1), IntegerOfTerm(t2) PASS_REGS);
177 case double_e: {
178 /* integer, double */
179 Float fl1 = (Float)IntegerOfTerm(t1);
180 Float fl2 = FloatOfTerm(t2);
181 RFLOAT(fl1 - fl2);
182 }
183 case big_int_e:
184 return Yap_gmp_sub_int_big(IntegerOfTerm(t1), t2);
185 default:
186 RERROR();
187 }
188 break;
189 case double_e:
190 switch (ETypeOfTerm(t2)) {
191 case long_int_e:
192 /* float * integer */
193 RFLOAT(FloatOfTerm(t1) - IntegerOfTerm(t2));
194 case double_e: {
195 RFLOAT(FloatOfTerm(t1) - FloatOfTerm(t2));
196 }
197 case big_int_e:
198 return Yap_gmp_sub_float_big(FloatOfTerm(t1), t2);
199 default:
200 RERROR();
201 }
202 break;
203 case big_int_e:
204 switch (ETypeOfTerm(t2)) {
205 case long_int_e:
206 return Yap_gmp_sub_big_int(t1, IntegerOfTerm(t2));
207 case big_int_e:
208 return Yap_gmp_sub_big_big(t1, t2);
209 case double_e:
210 return Yap_gmp_sub_big_float(t1, FloatOfTerm(t2));
211 default:
212 RERROR();
213 }
214 default:
215 RERROR();
216 }
217 RERROR();
218}
219
220static Term p_times(Term t1, Term t2 USES_REGS) {
221 switch (ETypeOfTerm(t1)) {
222 case long_int_e:
223 switch (ETypeOfTerm(t2)) {
224 case long_int_e:
225 /* two integers */
226 return (times_int(IntegerOfTerm(t1), IntegerOfTerm(t2) PASS_REGS));
227 case double_e: {
228 /* integer, double */
229 Float fl1 = (Float)IntegerOfTerm(t1);
230 Float fl2 = FloatOfTerm(t2);
231 RFLOAT(fl1 * fl2);
232 }
233 case big_int_e:
234 return (Yap_gmp_mul_int_big(IntegerOfTerm(t1), t2));
235 default:
236 RERROR();
237 }
238 break;
239 case double_e:
240 switch (ETypeOfTerm(t2)) {
241 case long_int_e:
242 /* float * integer */
243 RFLOAT(FloatOfTerm(t1) * IntegerOfTerm(t2));
244 case double_e:
245 RFLOAT(FloatOfTerm(t1) * FloatOfTerm(t2));
246 case big_int_e:
247 return Yap_gmp_mul_float_big(FloatOfTerm(t1), t2);
248 default:
249 RERROR();
250 }
251 break;
252 case big_int_e:
253 switch (ETypeOfTerm(t2)) {
254 case long_int_e:
255 return Yap_gmp_mul_int_big(IntegerOfTerm(t2), t1);
256 case big_int_e:
257 /* two bignums */
258 return Yap_gmp_mul_big_big(t1, t2);
259 case double_e:
260 return Yap_gmp_mul_float_big(FloatOfTerm(t2), t1);
261 default:
262 RERROR();
263 }
264 default:
265 RERROR();
266 }
267 RERROR();
268}
269
270static Term p_div(Term t1, Term t2 USES_REGS) {
271 switch (ETypeOfTerm(t1)) {
272 case long_int_e:
273 switch (ETypeOfTerm(t2)) {
274 case long_int_e:
275 /* two integers */
276 {
277 Int i1 = IntegerOfTerm(t1), i2 = IntegerOfTerm(t2);
278
279 if (i2 == 0) {
280 Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "// /2");
281 } else if (i1 == Int_MIN && i2 == -1) {
282 return Yap_gmp_add_ints(Int_MAX, 1);
283 } else {
284 RINT(IntegerOfTerm(t1) / i2);
285 }
286 }
287 case double_e:
288 Yap_ArithError(TYPE_ERROR_INTEGER, t2, "// /2");
289 case big_int_e:
290 /* dividing a bignum by an integer */
291 return Yap_gmp_div_int_big(IntegerOfTerm(t1), t2);
292 default:
293 RERROR();
294 }
295 break;
296 case double_e:
297 Yap_ArithError(TYPE_ERROR_INTEGER, t1, "// /2");
298 case big_int_e:
299 switch (ETypeOfTerm(t2)) {
300 case long_int_e:
301 /* dividing a bignum by an integer */
302 return Yap_gmp_div_big_int(t1, IntegerOfTerm(t2));
303 case big_int_e:
304 /* two bignums */
305 return Yap_gmp_div_big_big(t1, t2);
306 case double_e:
307 Yap_ArithError(TYPE_ERROR_INTEGER, t2, "// /2");
308 default:
309 RERROR();
310 }
311 default:
312 RERROR();
313 }
314 RERROR();
315}
316
317static Term p_and(Term t1, Term t2 USES_REGS) {
318 switch (ETypeOfTerm(t1)) {
319 case long_int_e:
320 switch (ETypeOfTerm(t2)) {
321 case long_int_e:
322 /* two integers */
323 RINT(IntegerOfTerm(t1) & IntegerOfTerm(t2));
324 case double_e:
325 Yap_ArithError(TYPE_ERROR_INTEGER, t2, "/\\ /2");
326 case big_int_e:
327 return Yap_gmp_and_int_big(IntegerOfTerm(t1), t2);
328 default:
329 RERROR();
330 }
331 break;
332 case double_e:
333 Yap_ArithError(TYPE_ERROR_INTEGER, t1, "/\\ /2");
334 case big_int_e:
335 switch (ETypeOfTerm(t2)) {
336 case long_int_e:
337 /* anding a bignum with an integer is easy */
338 return Yap_gmp_and_int_big(IntegerOfTerm(t2), t1);
339 case big_int_e:
340 /* two bignums */
341 return Yap_gmp_and_big_big(t1, t2);
342 case double_e:
343 Yap_ArithError(TYPE_ERROR_INTEGER, t2, "/\\ /2");
344 default:
345 RERROR();
346 }
347 default:
348 RERROR();
349 }
350 RERROR();
351}
352
353static Term p_or(Term t1, Term t2 USES_REGS) {
354 switch (ETypeOfTerm(t1)) {
355 case long_int_e:
356 switch (ETypeOfTerm(t2)) {
357 case long_int_e:
358 /* two integers */
359 RINT(IntegerOfTerm(t1) | IntegerOfTerm(t2));
360 case double_e:
361 Yap_ArithError(TYPE_ERROR_INTEGER, t2, "\\/ /2");
362 case big_int_e:
363 return Yap_gmp_ior_int_big(IntegerOfTerm(t1), t2);
364 default:
365 RERROR();
366 }
367 break;
368 case double_e:
369 Yap_ArithError(TYPE_ERROR_INTEGER, t1, "\\/ /2");
370 case big_int_e:
371 switch (ETypeOfTerm(t2)) {
372 case long_int_e:
373 /* anding a bignum with an integer is easy */
374 return Yap_gmp_ior_int_big(IntegerOfTerm(t2), t1);
375 case big_int_e:
376 /* two bignums */
377 return Yap_gmp_ior_big_big(t1, t2);
378 case double_e:
379 Yap_ArithError(TYPE_ERROR_INTEGER, t2, "\\/ /2");
380 default:
381 RERROR();
382 }
383 default:
384 RERROR();
385 }
386 RERROR();
387}
388
389static Term p_sll(Term t1, Term t2 USES_REGS) {
390 switch (ETypeOfTerm(t1)) {
391 case long_int_e:
392 switch (ETypeOfTerm(t2)) {
393 case long_int_e:
394 /* two integers */
395 {
396 Int i2 = IntegerOfTerm(t2);
397
398 if (i2 <= 0) {
399 if (i2 == Int_MIN) {
400 Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, ">>/2");
401 }
402 RINT(SLR(IntegerOfTerm(t1), -i2));
403 }
404 return do_sll(IntegerOfTerm(t1), i2 PASS_REGS);
405 }
406 case double_e:
407 Yap_ArithError(TYPE_ERROR_INTEGER, t2, "<</2");
408 case big_int_e:
409 Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, "<</2");
410 default:
411 RERROR();
412 }
413 break;
414 case double_e:
415 Yap_ArithError(TYPE_ERROR_INTEGER, t1, "<< /2");
416 case big_int_e:
417 switch (ETypeOfTerm(t2)) {
418 case long_int_e:
419 return Yap_gmp_sll_big_int(t1, IntegerOfTerm(t2));
420 case big_int_e:
421 Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, ">>/2");
422 case double_e:
423 Yap_ArithError(TYPE_ERROR_INTEGER, t2, "<</2");
424 default:
425 RERROR();
426 }
427 default:
428 RERROR();
429 }
430 RERROR();
431}
432
433static Term p_slr(Term t1, Term t2 USES_REGS) {
434 switch (ETypeOfTerm(t1)) {
435 case long_int_e:
436 switch (ETypeOfTerm(t2)) {
437 case long_int_e:
438 /* two integers */
439 {
440 Int i2 = IntegerOfTerm(t2);
441
442 if (i2 < 0) {
443 if (i2 == Int_MIN) {
444 Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, ">>/2");
445 }
446 return do_sll(IntegerOfTerm(t1), -i2 PASS_REGS);
447 }
448 RINT(SLR(IntegerOfTerm(t1), i2));
449 }
450 case double_e:
451 Yap_ArithError(TYPE_ERROR_INTEGER, t2, ">>/2");
452 case big_int_e:
453 Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, ">>/2");
454 default:
455 RERROR();
456 }
457 break;
458 case double_e:
459 Yap_ArithError(TYPE_ERROR_INTEGER, t1, ">>/2");
460 case big_int_e:
461 switch (ETypeOfTerm(t2)) {
462 case long_int_e:
463 return Yap_gmp_sll_big_int(t1, -IntegerOfTerm(t2));
464 case big_int_e:
465 Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, ">>/2");
466 case double_e:
467 Yap_ArithError(TYPE_ERROR_INTEGER, t2, ">>/2");
468 default:
469 RERROR();
470 }
471 default:
472 RERROR();
473 }
474 RERROR();
475}