1 /*
2 * %CopyrightBegin%
3 *
4 * Copyright Ericsson AB 1999-2018. All Rights Reserved.
5 *
6 * Licensed under the Apache License, Version 2.0 (the "License");
7 * you may not use this file except in compliance with the License.
8 * You may obtain a copy of the License at
9 *
10 * http://www.apache.org/licenses/LICENSE-2.0
11 *
12 * Unless required by applicable law or agreed to in writing, software
13 * distributed under the License is distributed on an "AS IS" BASIS,
14 * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15 * See the License for the specific language governing permissions and
16 * limitations under the License.
17 *
18 * %CopyrightEnd%
19 */
20
21 /*
22 * Arithmetic functions formerly found in beam_emu.c
23 * now available as bifs as erl_db_util and db_match_compile needs
24 * them.
25 */
26
27
28 #ifdef HAVE_CONFIG_H
29 # include "config.h"
30 #endif
31
32 #include "sys.h"
33 #include "erl_vm.h"
34 #include "global.h"
35 #include "erl_process.h"
36 #include "error.h"
37 #include "bif.h"
38 #include "big.h"
39 #include "atom.h"
40
41 #ifndef MAX
42 # define MAX(x, y) (((x) > (y)) ? (x) : (y))
43 #endif
44
45 #define DECLARE_TMP(VariableName,N,P) Eterm VariableName[2]
46 #define ARG_IS_NOT_TMP(Arg,Tmp) ((Arg) != make_big((Tmp)))
47
48 static Eterm shift(Process* p, Eterm arg1, Eterm arg2, int right);
49
maybe_shrink(Process * p,Eterm * hp,Eterm res,Uint alloc)50 static ERTS_INLINE void maybe_shrink(Process* p, Eterm* hp, Eterm res, Uint alloc)
51 {
52 Uint actual;
53
54 if (is_immed(res)) {
55 ASSERT(!(p->heap <= hp && hp < p->htop));
56 erts_heap_frag_shrink(p, hp);
57 } else if ((actual = bignum_header_arity(*hp)+1) < alloc) {
58 ASSERT(!(p->heap <= hp && hp < p->htop));
59 erts_heap_frag_shrink(p, hp+actual);
60 }
61 }
62
63 /*
64 * BIF interfaces. They will only be from match specs and
65 * when a BIF is applied.
66 */
67
splus_1(BIF_ALIST_1)68 BIF_RETTYPE splus_1(BIF_ALIST_1)
69 {
70 if (is_number(BIF_ARG_1)) {
71 BIF_RET(BIF_ARG_1);
72 } else {
73 BIF_ERROR(BIF_P, BADARITH);
74 }
75 }
76
splus_2(BIF_ALIST_2)77 BIF_RETTYPE splus_2(BIF_ALIST_2)
78 {
79 BIF_RET(erts_mixed_plus(BIF_P, BIF_ARG_1, BIF_ARG_2));
80 }
81
sminus_1(BIF_ALIST_1)82 BIF_RETTYPE sminus_1(BIF_ALIST_1)
83 {
84 BIF_RET(erts_mixed_minus(BIF_P, make_small(0), BIF_ARG_1));
85 }
86
sminus_2(BIF_ALIST_2)87 BIF_RETTYPE sminus_2(BIF_ALIST_2)
88 {
89 BIF_RET(erts_mixed_minus(BIF_P, BIF_ARG_1, BIF_ARG_2));
90 }
91
stimes_2(BIF_ALIST_2)92 BIF_RETTYPE stimes_2(BIF_ALIST_2)
93 {
94 BIF_RET(erts_mixed_times(BIF_P, BIF_ARG_1, BIF_ARG_2));
95 }
96
div_2(BIF_ALIST_2)97 BIF_RETTYPE div_2(BIF_ALIST_2)
98 {
99 BIF_RET(erts_mixed_div(BIF_P, BIF_ARG_1, BIF_ARG_2));
100 }
101
intdiv_2(BIF_ALIST_2)102 BIF_RETTYPE intdiv_2(BIF_ALIST_2)
103 {
104 if (BIF_ARG_2 == SMALL_ZERO) {
105 BIF_ERROR(BIF_P, BADARITH);
106 }
107 if (is_both_small(BIF_ARG_1,BIF_ARG_2)){
108 Sint ires = signed_val(BIF_ARG_1) / signed_val(BIF_ARG_2);
109 if (IS_SSMALL(ires))
110 BIF_RET(make_small(ires));
111 }
112 BIF_RET(erts_int_div(BIF_P, BIF_ARG_1, BIF_ARG_2));
113 }
114
rem_2(BIF_ALIST_2)115 BIF_RETTYPE rem_2(BIF_ALIST_2)
116 {
117 if (BIF_ARG_2 == SMALL_ZERO) {
118 BIF_ERROR(BIF_P, BADARITH);
119 }
120 if (is_both_small(BIF_ARG_1,BIF_ARG_2)){
121 /* Is this really correct? Isn't there a difference between
122 remainder and modulo that is not defined in C? Well, I don't
123 remember, this is the way it's done in beam_emu anyway... */
124 BIF_RET(make_small(signed_val(BIF_ARG_1) % signed_val(BIF_ARG_2)));
125 }
126 BIF_RET(erts_int_rem(BIF_P, BIF_ARG_1, BIF_ARG_2));
127 }
128
band_2(BIF_ALIST_2)129 BIF_RETTYPE band_2(BIF_ALIST_2)
130 {
131 if (is_both_small(BIF_ARG_1,BIF_ARG_2)){
132 BIF_RET(BIF_ARG_1 & BIF_ARG_2);
133 }
134 BIF_RET(erts_band(BIF_P, BIF_ARG_1, BIF_ARG_2));
135 }
136
bor_2(BIF_ALIST_2)137 BIF_RETTYPE bor_2(BIF_ALIST_2)
138 {
139 if (is_both_small(BIF_ARG_1,BIF_ARG_2)){
140 BIF_RET(BIF_ARG_1 | BIF_ARG_2);
141 }
142 BIF_RET(erts_bor(BIF_P, BIF_ARG_1, BIF_ARG_2));
143 }
144
bxor_2(BIF_ALIST_2)145 BIF_RETTYPE bxor_2(BIF_ALIST_2)
146 {
147 if (is_both_small(BIF_ARG_1,BIF_ARG_2)){
148 BIF_RET(make_small(signed_val(BIF_ARG_1) ^ signed_val(BIF_ARG_2)));
149 }
150 BIF_RET(erts_bxor(BIF_P, BIF_ARG_1, BIF_ARG_2));
151 }
152
bsl_2(BIF_ALIST_2)153 BIF_RETTYPE bsl_2(BIF_ALIST_2)
154 {
155 BIF_RET(shift(BIF_P, BIF_ARG_1, BIF_ARG_2, 0));
156 }
157
bsr_2(BIF_ALIST_2)158 BIF_RETTYPE bsr_2(BIF_ALIST_2)
159 {
160 BIF_RET(shift(BIF_P, BIF_ARG_1, BIF_ARG_2, 1));
161 }
162
163 static Eterm
shift(Process * p,Eterm arg1,Eterm arg2,int right)164 shift(Process* p, Eterm arg1, Eterm arg2, int right)
165 {
166 Sint i;
167 Sint ires;
168 DECLARE_TMP(tmp_big1,0,p);
169 Eterm* bigp;
170 Uint need;
171
172 if (right) {
173 if (is_small(arg2)) {
174 i = -signed_val(arg2);
175 if (is_small(arg1)) {
176 goto small_shift;
177 } else if (is_big(arg1)) {
178 if (i == 0) {
179 BIF_RET(arg1);
180 }
181 goto big_shift;
182 }
183 } else if (is_big(arg2)) {
184 /*
185 * N bsr NegativeBigNum == N bsl MAX_SMALL
186 * N bsr PositiveBigNum == N bsl MIN_SMALL
187 */
188 arg2 = make_small(bignum_header_is_neg(*big_val(arg2)) ?
189 MAX_SMALL : MIN_SMALL);
190 goto do_bsl;
191 }
192 } else {
193 do_bsl:
194 if (is_small(arg2)) {
195 i = signed_val(arg2);
196
197 if (is_small(arg1)) {
198 small_shift:
199 ires = signed_val(arg1);
200
201 if (i == 0 || ires == 0) {
202 BIF_RET(arg1);
203 } else if (i < 0) { /* Right shift */
204 i = -i;
205 if (i >= SMALL_BITS-1) {
206 arg1 = (ires < 0) ? SMALL_MINUS_ONE : SMALL_ZERO;
207 } else {
208 arg1 = make_small(ires >> i);
209 }
210 BIF_RET(arg1);
211 } else if (i < SMALL_BITS-1) { /* Left shift */
212 if ((ires > 0 && ((~(Uint)0 << ((SMALL_BITS-1)-i)) & ires) == 0) ||
213 ((~(Uint)0 << ((SMALL_BITS-1)-i)) & ~ires) == 0) {
214 arg1 = make_small(ires << i);
215 BIF_RET(arg1);
216 }
217 }
218 arg1 = small_to_big(ires, tmp_big1);
219
220 big_shift:
221 if (i > 0) { /* Left shift. */
222 ires = big_size(arg1) + (i / D_EXP);
223 } else { /* Right shift. */
224 ires = big_size(arg1);
225 if (ires <= (-i / D_EXP))
226 ires = 3;
227 else
228 ires -= (-i / D_EXP);
229 }
230
231 /*
232 * Slightly conservative check the size to avoid
233 * allocating huge amounts of memory for bignums that
234 * clearly would overflow the arity in the header
235 * word.
236 */
237 if (ires-8 > BIG_ARITY_MAX) {
238 BIF_ERROR(p, SYSTEM_LIMIT);
239 }
240 need = BIG_NEED_SIZE(ires+1);
241 bigp = HeapFragOnlyAlloc(p, need);
242 arg1 = big_lshift(arg1, i, bigp);
243 maybe_shrink(p, bigp, arg1, need);
244 if (is_nil(arg1)) {
245 /*
246 * This result must have been only slight larger
247 * than allowed since it wasn't caught by the
248 * previous test.
249 */
250 BIF_ERROR(p, SYSTEM_LIMIT);
251 }
252 BIF_RET(arg1);
253 } else if (is_big(arg1)) {
254 if (i == 0) {
255 BIF_RET(arg1);
256 }
257 goto big_shift;
258 }
259 } else if (is_big(arg2)) {
260 if (bignum_header_is_neg(*big_val(arg2))) {
261 /*
262 * N bsl NegativeBigNum is either 0 or -1, depending on
263 * the sign of N. Since we don't believe this case
264 * is common, do the calculation with the minimum
265 * amount of code.
266 */
267 arg2 = make_small(MIN_SMALL);
268 goto do_bsl;
269 } else if (is_small(arg1) || is_big(arg1)) {
270 /*
271 * N bsl PositiveBigNum is too large to represent,
272 * unless N is 0.
273 */
274 if (arg1 == make_small(0)) {
275 BIF_RET(arg1);
276 }
277 BIF_ERROR(p, SYSTEM_LIMIT);
278 }
279 /* Fall through if the left argument is not an integer. */
280 }
281 }
282 BIF_ERROR(p, BADARITH);
283 }
284
bnot_1(BIF_ALIST_1)285 BIF_RETTYPE bnot_1(BIF_ALIST_1)
286 {
287 Eterm ret;
288
289 if (is_small(BIF_ARG_1)) {
290 ret = make_small(~signed_val(BIF_ARG_1));
291 } else if (is_big(BIF_ARG_1)) {
292 Uint need = BIG_NEED_SIZE(big_size(BIF_ARG_1)+1);
293 Eterm* bigp = HeapFragOnlyAlloc(BIF_P, need);
294
295 ret = big_bnot(BIF_ARG_1, bigp);
296 maybe_shrink(BIF_P, bigp, ret, need);
297 if (is_nil(ret)) {
298 BIF_ERROR(BIF_P, SYSTEM_LIMIT);
299 }
300 } else {
301 BIF_ERROR(BIF_P, BADARITH);
302 }
303 BIF_RET(ret);
304 }
305
306 /*
307 * Implementation and interfaces for the rest of the runtime system.
308 * The functions that follow are only used in match specs and when
309 * arithmetic functions are applied.
310 */
311
312 Eterm
erts_mixed_plus(Process * p,Eterm arg1,Eterm arg2)313 erts_mixed_plus(Process* p, Eterm arg1, Eterm arg2)
314 {
315 DECLARE_TMP(tmp_big1,0,p);
316 DECLARE_TMP(tmp_big2,1,p);
317 Eterm res;
318 Eterm hdr;
319 FloatDef f1, f2;
320 dsize_t sz1, sz2, sz;
321 int need_heap;
322 Eterm* hp;
323 Sint ires;
324
325 ERTS_FP_CHECK_INIT(p);
326 switch (arg1 & _TAG_PRIMARY_MASK) {
327 case TAG_PRIMARY_IMMED1:
328 switch ((arg1 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
329 case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
330 switch (arg2 & _TAG_PRIMARY_MASK) {
331 case TAG_PRIMARY_IMMED1:
332 switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
333 case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
334 ires = signed_val(arg1) + signed_val(arg2);
335 if (IS_SSMALL(ires)) {
336 return make_small(ires);
337 } else {
338 hp = HeapFragOnlyAlloc(p, 2);
339 res = small_to_big(ires, hp);
340 return res;
341 }
342 default:
343 badarith:
344 p->freason = BADARITH;
345 return THE_NON_VALUE;
346 }
347 case TAG_PRIMARY_BOXED:
348 hdr = *boxed_val(arg2);
349 switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
350 case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
351 case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
352 if (arg1 == SMALL_ZERO) {
353 return arg2;
354 }
355 arg1 = small_to_big(signed_val(arg1), tmp_big1);
356 goto do_big;
357 case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
358 f1.fd = signed_val(arg1);
359 GET_DOUBLE(arg2, f2);
360 goto do_float;
361 default:
362 goto badarith;
363 }
364 }
365 default:
366 goto badarith;
367 }
368 case TAG_PRIMARY_BOXED:
369 hdr = *boxed_val(arg1);
370 switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
371 case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
372 case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
373 switch (arg2 & _TAG_PRIMARY_MASK) {
374 case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
375 switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
376 case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
377 if (arg2 == SMALL_ZERO) {
378 return arg1;
379 }
380 arg2 = small_to_big(signed_val(arg2), tmp_big2);
381 goto do_big;
382 default:
383 goto badarith;
384 }
385 case TAG_PRIMARY_BOXED:
386 hdr = *boxed_val(arg2);
387 switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
388 case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
389 case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
390 do_big:
391 sz1 = big_size(arg1);
392 sz2 = big_size(arg2);
393 sz = MAX(sz1, sz2)+1;
394 need_heap = BIG_NEED_SIZE(sz);
395 hp = HeapFragOnlyAlloc(p, need_heap);
396 res = big_plus(arg1, arg2, hp);
397 maybe_shrink(p, hp, res, need_heap);
398 if (is_nil(res)) {
399 p->freason = SYSTEM_LIMIT;
400 return THE_NON_VALUE;
401 }
402 return res;
403 case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
404 if (big_to_double(arg1, &f1.fd) < 0) {
405 goto badarith;
406 }
407 GET_DOUBLE(arg2, f2);
408 goto do_float;
409 default:
410 goto badarith;
411 }
412 }
413 case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
414 switch (arg2 & _TAG_PRIMARY_MASK) {
415 case TAG_PRIMARY_IMMED1:
416 switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
417 case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
418 GET_DOUBLE(arg1, f1);
419 f2.fd = signed_val(arg2);
420 goto do_float;
421 default:
422 goto badarith;
423 }
424 case TAG_PRIMARY_BOXED:
425 hdr = *boxed_val(arg2);
426 switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
427 case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
428 case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
429 GET_DOUBLE(arg1, f1);
430 if (big_to_double(arg2, &f2.fd) < 0) {
431 goto badarith;
432 }
433 goto do_float;
434 case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
435 GET_DOUBLE(arg1, f1);
436 GET_DOUBLE(arg2, f2);
437
438 do_float:
439 f1.fd = f1.fd + f2.fd;
440 ERTS_FP_ERROR(p, f1.fd, goto badarith);
441 hp = HeapFragOnlyAlloc(p, FLOAT_SIZE_OBJECT);
442 res = make_float(hp);
443 PUT_DOUBLE(f1, hp);
444 return res;
445 default:
446 goto badarith;
447 }
448 default:
449 goto badarith;
450 }
451 }
452 default:
453 goto badarith;
454 }
455 }
456
457 Eterm
erts_mixed_minus(Process * p,Eterm arg1,Eterm arg2)458 erts_mixed_minus(Process* p, Eterm arg1, Eterm arg2)
459 {
460 DECLARE_TMP(tmp_big1,0,p);
461 DECLARE_TMP(tmp_big2,1,p);
462 Eterm hdr;
463 Eterm res;
464 FloatDef f1, f2;
465 dsize_t sz1, sz2, sz;
466 int need_heap;
467 Eterm* hp;
468 Sint ires;
469
470 ERTS_FP_CHECK_INIT(p);
471 switch (arg1 & _TAG_PRIMARY_MASK) {
472 case TAG_PRIMARY_IMMED1:
473 switch ((arg1 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
474 case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
475 switch (arg2 & _TAG_PRIMARY_MASK) {
476 case TAG_PRIMARY_IMMED1:
477 switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
478 case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
479 ires = signed_val(arg1) - signed_val(arg2);
480 if (IS_SSMALL(ires)) {
481 return make_small(ires);
482 } else {
483 hp = HeapFragOnlyAlloc(p, 2);
484 res = small_to_big(ires, hp);
485 return res;
486 }
487 default:
488 badarith:
489 p->freason = BADARITH;
490 return THE_NON_VALUE;
491 }
492 case TAG_PRIMARY_BOXED:
493 hdr = *boxed_val(arg2);
494 switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
495 case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
496 case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
497 arg1 = small_to_big(signed_val(arg1), tmp_big1);
498 goto do_big;
499 case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
500 f1.fd = signed_val(arg1);
501 GET_DOUBLE(arg2, f2);
502 goto do_float;
503 default:
504 goto badarith;
505 }
506 }
507 default:
508 goto badarith;
509 }
510 case TAG_PRIMARY_BOXED:
511 hdr = *boxed_val(arg1);
512 switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
513 case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
514 case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
515 switch (arg2 & _TAG_PRIMARY_MASK) {
516 case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
517 switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
518 case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
519 if (arg2 == SMALL_ZERO) {
520 return arg1;
521 }
522 arg2 = small_to_big(signed_val(arg2), tmp_big2);
523
524 do_big:
525 sz1 = big_size(arg1);
526 sz2 = big_size(arg2);
527 sz = MAX(sz1, sz2)+1;
528 need_heap = BIG_NEED_SIZE(sz);
529 hp = HeapFragOnlyAlloc(p, need_heap);
530 res = big_minus(arg1, arg2, hp);
531 maybe_shrink(p, hp, res, need_heap);
532 if (is_nil(res)) {
533 p->freason = SYSTEM_LIMIT;
534 return THE_NON_VALUE;
535 }
536 return res;
537 default:
538 goto badarith;
539 }
540 case TAG_PRIMARY_BOXED:
541 hdr = *boxed_val(arg2);
542 switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
543 case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
544 case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
545 goto do_big;
546 case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
547 if (big_to_double(arg1, &f1.fd) < 0) {
548 goto badarith;
549 }
550 GET_DOUBLE(arg2, f2);
551 goto do_float;
552 default:
553 goto badarith;
554 }
555 }
556 case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
557 switch (arg2 & _TAG_PRIMARY_MASK) {
558 case TAG_PRIMARY_IMMED1:
559 switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
560 case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
561 GET_DOUBLE(arg1, f1);
562 f2.fd = signed_val(arg2);
563 goto do_float;
564 default:
565 goto badarith;
566 }
567 case TAG_PRIMARY_BOXED:
568 hdr = *boxed_val(arg2);
569 switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
570 case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
571 case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
572 GET_DOUBLE(arg1, f1);
573 if (big_to_double(arg2, &f2.fd) < 0) {
574 goto badarith;
575 }
576 goto do_float;
577 case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
578 GET_DOUBLE(arg1, f1);
579 GET_DOUBLE(arg2, f2);
580
581 do_float:
582 f1.fd = f1.fd - f2.fd;
583 ERTS_FP_ERROR(p, f1.fd, goto badarith);
584 hp = HeapFragOnlyAlloc(p, FLOAT_SIZE_OBJECT);
585 res = make_float(hp);
586 PUT_DOUBLE(f1, hp);
587 return res;
588 default:
589 goto badarith;
590 }
591 default:
592 goto badarith;
593 }
594 }
595 default:
596 goto badarith;
597 }
598 }
599
600 Eterm
erts_mixed_times(Process * p,Eterm arg1,Eterm arg2)601 erts_mixed_times(Process* p, Eterm arg1, Eterm arg2)
602 {
603 DECLARE_TMP(tmp_big1,0,p);
604 DECLARE_TMP(tmp_big2,1,p);
605 Eterm hdr;
606 Eterm res;
607 FloatDef f1, f2;
608 dsize_t sz1, sz2, sz;
609 int need_heap;
610 Eterm* hp;
611
612 ERTS_FP_CHECK_INIT(p);
613 switch (arg1 & _TAG_PRIMARY_MASK) {
614 case TAG_PRIMARY_IMMED1:
615 switch ((arg1 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
616 case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
617 switch (arg2 & _TAG_PRIMARY_MASK) {
618 case TAG_PRIMARY_IMMED1:
619 switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
620 case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
621 if ((arg1 == SMALL_ZERO) || (arg2 == SMALL_ZERO)) {
622 return(SMALL_ZERO);
623 } else if (arg1 == SMALL_ONE) {
624 return(arg2);
625 } else if (arg2 == SMALL_ONE) {
626 return(arg1);
627 } else {
628 DeclareTmpHeap(big_res,3,p);
629 UseTmpHeap(3,p);
630 /*
631 * The following code is optimized for the case that
632 * result is small (which should be the most common case
633 * in practice).
634 */
635 res = small_times(signed_val(arg1), signed_val(arg2), big_res);
636 if (is_small(res)) {
637 UnUseTmpHeap(3,p);
638 return res;
639 } else {
640 /*
641 * The result is a a big number.
642 * Allocate a heap fragment and copy the result.
643 * Be careful to allocate exactly what we need
644 * to not leave any holes.
645 */
646 Uint arity;
647
648 ASSERT(is_big(res));
649 hdr = big_res[0];
650 arity = bignum_header_arity(hdr);
651 ASSERT(arity == 1 || arity == 2);
652 hp = HeapFragOnlyAlloc(p, arity+1);
653 res = make_big(hp);
654 *hp++ = hdr;
655 *hp++ = big_res[1];
656 if (arity > 1) {
657 *hp = big_res[2];
658 }
659 UnUseTmpHeap(3,p);
660 return res;
661 }
662 }
663 default:
664 badarith:
665 p->freason = BADARITH;
666 return THE_NON_VALUE;
667 }
668 case TAG_PRIMARY_BOXED:
669 hdr = *boxed_val(arg2);
670 switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
671 case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
672 case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
673 if (arg1 == SMALL_ZERO)
674 return(SMALL_ZERO);
675 if (arg1 == SMALL_ONE)
676 return(arg2);
677 arg1 = small_to_big(signed_val(arg1), tmp_big1);
678 sz = 2 + big_size(arg2);
679 goto do_big;
680 case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
681 f1.fd = signed_val(arg1);
682 GET_DOUBLE(arg2, f2);
683 goto do_float;
684 default:
685 goto badarith;
686 }
687 }
688 default:
689 goto badarith;
690 }
691 case TAG_PRIMARY_BOXED:
692 hdr = *boxed_val(arg1);
693 switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
694 case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
695 case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
696 switch (arg2 & _TAG_PRIMARY_MASK) {
697 case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
698 switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
699 case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
700 if (arg2 == SMALL_ZERO)
701 return(SMALL_ZERO);
702 if (arg2 == SMALL_ONE)
703 return(arg1);
704 arg2 = small_to_big(signed_val(arg2), tmp_big2);
705 sz = 2 + big_size(arg1);
706 goto do_big;
707 default:
708 goto badarith;
709 }
710 case TAG_PRIMARY_BOXED:
711 hdr = *boxed_val(arg2);
712 switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
713 case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
714 case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
715 sz1 = big_size(arg1);
716 sz2 = big_size(arg2);
717 sz = sz1 + sz2;
718
719 do_big:
720 need_heap = BIG_NEED_SIZE(sz);
721 hp = HeapFragOnlyAlloc(p, need_heap);
722 res = big_times(arg1, arg2, hp);
723
724 /*
725 * Note that the result must be big in this case, since
726 * at least one operand was big to begin with, and
727 * the absolute value of the other is > 1.
728 */
729
730 maybe_shrink(p, hp, res, need_heap);
731 if (is_nil(res)) {
732 p->freason = SYSTEM_LIMIT;
733 return THE_NON_VALUE;
734 }
735 return res;
736 case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
737 if (big_to_double(arg1, &f1.fd) < 0) {
738 goto badarith;
739 }
740 GET_DOUBLE(arg2, f2);
741 goto do_float;
742 default:
743 goto badarith;
744 }
745 }
746 case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
747 switch (arg2 & _TAG_PRIMARY_MASK) {
748 case TAG_PRIMARY_IMMED1:
749 switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
750 case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
751 GET_DOUBLE(arg1, f1);
752 f2.fd = signed_val(arg2);
753 goto do_float;
754 default:
755 goto badarith;
756 }
757 case TAG_PRIMARY_BOXED:
758 hdr = *boxed_val(arg2);
759 switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
760 case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
761 case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
762 GET_DOUBLE(arg1, f1);
763 if (big_to_double(arg2, &f2.fd) < 0) {
764 goto badarith;
765 }
766 goto do_float;
767 case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
768 GET_DOUBLE(arg1, f1);
769 GET_DOUBLE(arg2, f2);
770
771 do_float:
772 f1.fd = f1.fd * f2.fd;
773 ERTS_FP_ERROR(p, f1.fd, goto badarith);
774 hp = HeapFragOnlyAlloc(p, FLOAT_SIZE_OBJECT);
775 res = make_float(hp);
776 PUT_DOUBLE(f1, hp);
777 return res;
778 default:
779 goto badarith;
780 }
781 default:
782 goto badarith;
783 }
784 }
785 default:
786 goto badarith;
787 }
788 }
789
790 Eterm
erts_mixed_div(Process * p,Eterm arg1,Eterm arg2)791 erts_mixed_div(Process* p, Eterm arg1, Eterm arg2)
792 {
793 FloatDef f1, f2;
794 Eterm* hp;
795 Eterm hdr;
796
797 ERTS_FP_CHECK_INIT(p);
798 switch (arg1 & _TAG_PRIMARY_MASK) {
799 case TAG_PRIMARY_IMMED1:
800 switch ((arg1 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
801 case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
802 switch (arg2 & _TAG_PRIMARY_MASK) {
803 case TAG_PRIMARY_IMMED1:
804 switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
805 case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
806 f1.fd = signed_val(arg1);
807 f2.fd = signed_val(arg2);
808 goto do_float;
809 default:
810 badarith:
811 p->freason = BADARITH;
812 return THE_NON_VALUE;
813 }
814 case TAG_PRIMARY_BOXED:
815 hdr = *boxed_val(arg2);
816 switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
817 case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
818 case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
819 f1.fd = signed_val(arg1);
820 if (big_to_double(arg2, &f2.fd) < 0) {
821 goto badarith;
822 }
823 goto do_float;
824 case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
825 f1.fd = signed_val(arg1);
826 GET_DOUBLE(arg2, f2);
827 goto do_float;
828 default:
829 goto badarith;
830 }
831 }
832 default:
833 goto badarith;
834 }
835 case TAG_PRIMARY_BOXED:
836 hdr = *boxed_val(arg1);
837 switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
838 case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
839 case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
840 switch (arg2 & _TAG_PRIMARY_MASK) {
841 case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
842 switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
843 case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
844 if (big_to_double(arg1, &f1.fd) < 0) {
845 goto badarith;
846 }
847 f2.fd = signed_val(arg2);
848 goto do_float;
849 default:
850 goto badarith;
851 }
852 case TAG_PRIMARY_BOXED:
853 hdr = *boxed_val(arg2);
854 switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
855 case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
856 case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
857 if (big_to_double(arg1, &f1.fd) < 0 ||
858 big_to_double(arg2, &f2.fd) < 0) {
859 goto badarith;
860 }
861 goto do_float;
862 case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
863 if (big_to_double(arg1, &f1.fd) < 0) {
864 goto badarith;
865 }
866 GET_DOUBLE(arg2, f2);
867 goto do_float;
868 default:
869 goto badarith;
870 }
871 }
872 case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
873 switch (arg2 & _TAG_PRIMARY_MASK) {
874 case TAG_PRIMARY_IMMED1:
875 switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
876 case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
877 GET_DOUBLE(arg1, f1);
878 f2.fd = signed_val(arg2);
879 goto do_float;
880 default:
881 goto badarith;
882 }
883 case TAG_PRIMARY_BOXED:
884 hdr = *boxed_val(arg2);
885 switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
886 case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
887 case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
888 GET_DOUBLE(arg1, f1);
889 if (big_to_double(arg2, &f2.fd) < 0) {
890 goto badarith;
891 }
892 goto do_float;
893 case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
894 GET_DOUBLE(arg1, f1);
895 GET_DOUBLE(arg2, f2);
896
897 do_float:
898 f1.fd = f1.fd / f2.fd;
899 ERTS_FP_ERROR(p, f1.fd, goto badarith);
900 hp = HeapFragOnlyAlloc(p, FLOAT_SIZE_OBJECT);
901 PUT_DOUBLE(f1, hp);
902 return make_float(hp);
903 default:
904 goto badarith;
905 }
906 default:
907 goto badarith;
908 }
909 }
910 default:
911 goto badarith;
912 }
913 }
914
915 Eterm
erts_int_div(Process * p,Eterm arg1,Eterm arg2)916 erts_int_div(Process* p, Eterm arg1, Eterm arg2)
917 {
918 DECLARE_TMP(tmp_big1,0,p);
919 DECLARE_TMP(tmp_big2,1,p);
920 int ires;
921
922 switch (NUMBER_CODE(arg1, arg2)) {
923 case SMALL_SMALL:
924 /* This case occurs if the most negative fixnum is divided by -1. */
925 ASSERT(arg2 == make_small(-1));
926 arg1 = small_to_big(signed_val(arg1), tmp_big1);
927 /*FALLTHROUGH*/
928 case BIG_SMALL:
929 arg2 = small_to_big(signed_val(arg2), tmp_big2);
930 goto L_big_div;
931 case SMALL_BIG:
932 if (arg1 != make_small(MIN_SMALL)) {
933 return SMALL_ZERO;
934 }
935 arg1 = small_to_big(signed_val(arg1), tmp_big1);
936 /*FALLTHROUGH*/
937 case BIG_BIG:
938 L_big_div:
939 ires = big_ucomp(arg1, arg2);
940 if (ires < 0) {
941 arg1 = SMALL_ZERO;
942 } else if (ires == 0) {
943 arg1 = (big_sign(arg1) == big_sign(arg2)) ?
944 SMALL_ONE : SMALL_MINUS_ONE;
945 } else {
946 Eterm* hp;
947 int i = big_size(arg1);
948 Uint need;
949
950 ires = big_size(arg2);
951 need = BIG_NEED_SIZE(i-ires+1) + BIG_NEED_SIZE(i);
952 hp = HeapFragOnlyAlloc(p, need);
953 arg1 = big_div(arg1, arg2, hp);
954 maybe_shrink(p, hp, arg1, need);
955 if (is_nil(arg1)) {
956 p->freason = SYSTEM_LIMIT;
957 return THE_NON_VALUE;
958 }
959 }
960 return arg1;
961 default:
962 p->freason = BADARITH;
963 return THE_NON_VALUE;
964 }
965 }
966
967 Eterm
erts_int_rem(Process * p,Eterm arg1,Eterm arg2)968 erts_int_rem(Process* p, Eterm arg1, Eterm arg2)
969 {
970 DECLARE_TMP(tmp_big1,0,p);
971 DECLARE_TMP(tmp_big2,1,p);
972 int ires;
973
974 switch (NUMBER_CODE(arg1, arg2)) {
975 case BIG_SMALL:
976 arg2 = small_to_big(signed_val(arg2), tmp_big2);
977 goto L_big_rem;
978 case SMALL_BIG:
979 if (arg1 != make_small(MIN_SMALL)) {
980 return arg1;
981 } else {
982 Eterm tmp;
983 tmp = small_to_big(signed_val(arg1), tmp_big1);
984 if ((ires = big_ucomp(tmp, arg2)) == 0) {
985 return SMALL_ZERO;
986 } else {
987 ASSERT(ires < 0);
988 return arg1;
989 }
990 }
991 /* All paths returned */
992 case BIG_BIG:
993 L_big_rem:
994 ires = big_ucomp(arg1, arg2);
995 if (ires == 0) {
996 arg1 = SMALL_ZERO;
997 } else if (ires > 0) {
998 Uint need = BIG_NEED_SIZE(big_size(arg1));
999 Eterm* hp = HeapFragOnlyAlloc(p, need);
1000
1001 arg1 = big_rem(arg1, arg2, hp);
1002 maybe_shrink(p, hp, arg1, need);
1003 if (is_nil(arg1)) {
1004 p->freason = SYSTEM_LIMIT;
1005 return THE_NON_VALUE;
1006 }
1007 }
1008 return arg1;
1009 default:
1010 p->freason = BADARITH;
1011 return THE_NON_VALUE;
1012 }
1013 }
1014
erts_band(Process * p,Eterm arg1,Eterm arg2)1015 Eterm erts_band(Process* p, Eterm arg1, Eterm arg2)
1016 {
1017 DECLARE_TMP(tmp_big1,0,p);
1018 DECLARE_TMP(tmp_big2,1,p);
1019 Eterm* hp;
1020 int need;
1021
1022 switch (NUMBER_CODE(arg1, arg2)) {
1023 case SMALL_BIG:
1024 arg1 = small_to_big(signed_val(arg1), tmp_big1);
1025 break;
1026 case BIG_SMALL:
1027 arg2 = small_to_big(signed_val(arg2), tmp_big2);
1028 break;
1029 case BIG_BIG:
1030 break;
1031 default:
1032 p->freason = BADARITH;
1033 return THE_NON_VALUE;
1034 }
1035 need = BIG_NEED_SIZE(MAX(big_size(arg1), big_size(arg2)) + 1);
1036 hp = HeapFragOnlyAlloc(p, need);
1037 arg1 = big_band(arg1, arg2, hp);
1038 ASSERT(is_not_nil(arg1));
1039 maybe_shrink(p, hp, arg1, need);
1040 return arg1;
1041 }
1042
erts_bor(Process * p,Eterm arg1,Eterm arg2)1043 Eterm erts_bor(Process* p, Eterm arg1, Eterm arg2)
1044 {
1045 DECLARE_TMP(tmp_big1,0,p);
1046 DECLARE_TMP(tmp_big2,1,p);
1047 Eterm* hp;
1048 int need;
1049
1050 switch (NUMBER_CODE(arg1, arg2)) {
1051 case SMALL_BIG:
1052 arg1 = small_to_big(signed_val(arg1), tmp_big1);
1053 break;
1054 case BIG_SMALL:
1055 arg2 = small_to_big(signed_val(arg2), tmp_big2);
1056 break;
1057 case BIG_BIG:
1058 break;
1059 default:
1060 p->freason = BADARITH;
1061 return THE_NON_VALUE;
1062 }
1063 need = BIG_NEED_SIZE(MAX(big_size(arg1), big_size(arg2)) + 1);
1064 hp = HeapFragOnlyAlloc(p, need);
1065 arg1 = big_bor(arg1, arg2, hp);
1066 ASSERT(is_not_nil(arg1));
1067 maybe_shrink(p, hp, arg1, need);
1068 return arg1;
1069 }
1070
erts_bxor(Process * p,Eterm arg1,Eterm arg2)1071 Eterm erts_bxor(Process* p, Eterm arg1, Eterm arg2)
1072 {
1073 DECLARE_TMP(tmp_big1,0,p);
1074 DECLARE_TMP(tmp_big2,1,p);
1075 Eterm* hp;
1076 int need;
1077
1078 switch (NUMBER_CODE(arg1, arg2)) {
1079 case SMALL_BIG:
1080 arg1 = small_to_big(signed_val(arg1), tmp_big1);
1081 break;
1082 case BIG_SMALL:
1083 arg2 = small_to_big(signed_val(arg2), tmp_big2);
1084 break;
1085 case BIG_BIG:
1086 break;
1087 default:
1088 p->freason = BADARITH;
1089 return THE_NON_VALUE;
1090 }
1091 need = BIG_NEED_SIZE(MAX(big_size(arg1), big_size(arg2)) + 1);
1092 hp = HeapFragOnlyAlloc(p, need);
1093 arg1 = big_bxor(arg1, arg2, hp);
1094 ASSERT(is_not_nil(arg1));
1095 maybe_shrink(p, hp, arg1, need);
1096 return arg1;
1097 }
1098
erts_bnot(Process * p,Eterm arg)1099 Eterm erts_bnot(Process* p, Eterm arg)
1100 {
1101 Eterm ret;
1102
1103 if (is_big(arg)) {
1104 Uint need = BIG_NEED_SIZE(big_size(arg)+1);
1105 Eterm* bigp = HeapFragOnlyAlloc(p, need);
1106
1107 ret = big_bnot(arg, bigp);
1108 maybe_shrink(p, bigp, ret, need);
1109 if (is_nil(ret)) {
1110 p->freason = SYSTEM_LIMIT;
1111 return NIL;
1112 }
1113 } else {
1114 p->freason = BADARITH;
1115 return NIL;
1116 }
1117 return ret;
1118 }
1119
1120 /* Needed to remove compiler optimization */
erts_get_positive_zero_float()1121 double erts_get_positive_zero_float() {
1122 return 0.0f;
1123 }
1124