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 if (p->heap <= hp && hp < p->htop) {
56 p->htop = hp;
57 }
58 else {
59 erts_heap_frag_shrink(p, hp);
60 }
61 } else if ((actual = bignum_header_arity(*hp)+1) < alloc) {
62 if (p->heap <= hp && hp < p->htop) {
63 p->htop = hp+actual;
64 }
65 else {
66 erts_heap_frag_shrink(p, hp+actual);
67 }
68 }
69 }
70
71 /*
72 * BIF interfaces. They will only be from match specs and
73 * when a BIF is applied.
74 */
75
splus_1(BIF_ALIST_1)76 BIF_RETTYPE splus_1(BIF_ALIST_1)
77 {
78 if (is_number(BIF_ARG_1)) {
79 BIF_RET(BIF_ARG_1);
80 } else {
81 BIF_ERROR(BIF_P, BADARITH);
82 }
83 }
84
splus_2(BIF_ALIST_2)85 BIF_RETTYPE splus_2(BIF_ALIST_2)
86 {
87 BIF_RET(erts_mixed_plus(BIF_P, BIF_ARG_1, BIF_ARG_2));
88 }
89
sminus_1(BIF_ALIST_1)90 BIF_RETTYPE sminus_1(BIF_ALIST_1)
91 {
92 BIF_RET(erts_mixed_minus(BIF_P, make_small(0), BIF_ARG_1));
93 }
94
sminus_2(BIF_ALIST_2)95 BIF_RETTYPE sminus_2(BIF_ALIST_2)
96 {
97 BIF_RET(erts_mixed_minus(BIF_P, BIF_ARG_1, BIF_ARG_2));
98 }
99
stimes_2(BIF_ALIST_2)100 BIF_RETTYPE stimes_2(BIF_ALIST_2)
101 {
102 BIF_RET(erts_mixed_times(BIF_P, BIF_ARG_1, BIF_ARG_2));
103 }
104
div_2(BIF_ALIST_2)105 BIF_RETTYPE div_2(BIF_ALIST_2)
106 {
107 BIF_RET(erts_mixed_div(BIF_P, BIF_ARG_1, BIF_ARG_2));
108 }
109
intdiv_2(BIF_ALIST_2)110 BIF_RETTYPE intdiv_2(BIF_ALIST_2)
111 {
112 if (BIF_ARG_2 == SMALL_ZERO) {
113 BIF_ERROR(BIF_P, BADARITH);
114 }
115 if (is_both_small(BIF_ARG_1,BIF_ARG_2)){
116 Sint ires = signed_val(BIF_ARG_1) / signed_val(BIF_ARG_2);
117 if (IS_SSMALL(ires))
118 BIF_RET(make_small(ires));
119 }
120 BIF_RET(erts_int_div(BIF_P, BIF_ARG_1, BIF_ARG_2));
121 }
122
rem_2(BIF_ALIST_2)123 BIF_RETTYPE rem_2(BIF_ALIST_2)
124 {
125 if (BIF_ARG_2 == SMALL_ZERO) {
126 BIF_ERROR(BIF_P, BADARITH);
127 }
128 if (is_both_small(BIF_ARG_1,BIF_ARG_2)){
129 /* Is this really correct? Isn't there a difference between
130 remainder and modulo that is not defined in C? Well, I don't
131 remember, this is the way it's done in beam_emu anyway... */
132 BIF_RET(make_small(signed_val(BIF_ARG_1) % signed_val(BIF_ARG_2)));
133 }
134 BIF_RET(erts_int_rem(BIF_P, BIF_ARG_1, BIF_ARG_2));
135 }
136
band_2(BIF_ALIST_2)137 BIF_RETTYPE band_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_band(BIF_P, BIF_ARG_1, BIF_ARG_2));
143 }
144
bor_2(BIF_ALIST_2)145 BIF_RETTYPE bor_2(BIF_ALIST_2)
146 {
147 if (is_both_small(BIF_ARG_1,BIF_ARG_2)){
148 BIF_RET(BIF_ARG_1 | BIF_ARG_2);
149 }
150 BIF_RET(erts_bor(BIF_P, BIF_ARG_1, BIF_ARG_2));
151 }
152
bxor_2(BIF_ALIST_2)153 BIF_RETTYPE bxor_2(BIF_ALIST_2)
154 {
155 if (is_both_small(BIF_ARG_1,BIF_ARG_2)){
156 BIF_RET(make_small(signed_val(BIF_ARG_1) ^ signed_val(BIF_ARG_2)));
157 }
158 BIF_RET(erts_bxor(BIF_P, BIF_ARG_1, BIF_ARG_2));
159 }
160
bsl_2(BIF_ALIST_2)161 BIF_RETTYPE bsl_2(BIF_ALIST_2)
162 {
163 BIF_RET(shift(BIF_P, BIF_ARG_1, BIF_ARG_2, 0));
164 }
165
bsr_2(BIF_ALIST_2)166 BIF_RETTYPE bsr_2(BIF_ALIST_2)
167 {
168 BIF_RET(shift(BIF_P, BIF_ARG_1, BIF_ARG_2, 1));
169 }
170
171 static Eterm
shift(Process * p,Eterm arg1,Eterm arg2,int right)172 shift(Process* p, Eterm arg1, Eterm arg2, int right)
173 {
174 Sint i;
175 Sint ires;
176 DECLARE_TMP(tmp_big1,0,p);
177 Eterm* bigp;
178 Uint need;
179
180 if (right) {
181 if (is_small(arg2)) {
182 i = -signed_val(arg2);
183 if (is_small(arg1)) {
184 goto small_shift;
185 } else if (is_big(arg1)) {
186 if (i == 0) {
187 BIF_RET(arg1);
188 }
189 goto big_shift;
190 }
191 } else if (is_big(arg2)) {
192 /*
193 * N bsr NegativeBigNum == N bsl MAX_SMALL
194 * N bsr PositiveBigNum == N bsl MIN_SMALL
195 */
196 arg2 = make_small(bignum_header_is_neg(*big_val(arg2)) ?
197 MAX_SMALL : MIN_SMALL);
198 goto do_bsl;
199 }
200 } else {
201 do_bsl:
202 if (is_small(arg2)) {
203 i = signed_val(arg2);
204
205 if (is_small(arg1)) {
206 small_shift:
207 ires = signed_val(arg1);
208
209 if (i == 0 || ires == 0) {
210 BIF_RET(arg1);
211 } else if (i < 0) { /* Right shift */
212 i = -i;
213 if (i >= SMALL_BITS-1) {
214 arg1 = (ires < 0) ? SMALL_MINUS_ONE : SMALL_ZERO;
215 } else {
216 arg1 = make_small(ires >> i);
217 }
218 BIF_RET(arg1);
219 } else if (i < SMALL_BITS-1) { /* Left shift */
220 if ((ires > 0 && ((~(Uint)0 << ((SMALL_BITS-1)-i)) & ires) == 0) ||
221 ((~(Uint)0 << ((SMALL_BITS-1)-i)) & ~ires) == 0) {
222 arg1 = make_small(ires << i);
223 BIF_RET(arg1);
224 }
225 }
226 arg1 = small_to_big(ires, tmp_big1);
227
228 big_shift:
229 if (i > 0) { /* Left shift. */
230 ires = big_size(arg1) + (i / D_EXP);
231 } else { /* Right shift. */
232 ires = big_size(arg1);
233 if (ires <= (-i / D_EXP))
234 ires = 3;
235 else
236 ires -= (-i / D_EXP);
237 }
238
239 /*
240 * Slightly conservative check the size to avoid
241 * allocating huge amounts of memory for bignums that
242 * clearly would overflow the arity in the header
243 * word.
244 */
245 if (ires-8 > BIG_ARITY_MAX) {
246 BIF_ERROR(p, SYSTEM_LIMIT);
247 }
248 need = BIG_NEED_SIZE(ires+1);
249 bigp = HAlloc(p, need);
250 arg1 = big_lshift(arg1, i, bigp);
251 maybe_shrink(p, bigp, arg1, need);
252 if (is_nil(arg1)) {
253 /*
254 * This result must have been only slight larger
255 * than allowed since it wasn't caught by the
256 * previous test.
257 */
258 BIF_ERROR(p, SYSTEM_LIMIT);
259 }
260 BIF_RET(arg1);
261 } else if (is_big(arg1)) {
262 if (i == 0) {
263 BIF_RET(arg1);
264 }
265 goto big_shift;
266 }
267 } else if (is_big(arg2)) {
268 if (bignum_header_is_neg(*big_val(arg2))) {
269 /*
270 * N bsl NegativeBigNum is either 0 or -1, depending on
271 * the sign of N. Since we don't believe this case
272 * is common, do the calculation with the minimum
273 * amount of code.
274 */
275 arg2 = make_small(MIN_SMALL);
276 goto do_bsl;
277 } else if (is_small(arg1) || is_big(arg1)) {
278 /*
279 * N bsl PositiveBigNum is too large to represent,
280 * unless N is 0.
281 */
282 if (arg1 == make_small(0)) {
283 BIF_RET(arg1);
284 }
285 BIF_ERROR(p, SYSTEM_LIMIT);
286 }
287 /* Fall through if the left argument is not an integer. */
288 }
289 }
290 BIF_ERROR(p, BADARITH);
291 }
292
bnot_1(BIF_ALIST_1)293 BIF_RETTYPE bnot_1(BIF_ALIST_1)
294 {
295 Eterm ret;
296
297 if (is_small(BIF_ARG_1)) {
298 ret = make_small(~signed_val(BIF_ARG_1));
299 } else if (is_big(BIF_ARG_1)) {
300 Uint need = BIG_NEED_SIZE(big_size(BIF_ARG_1)+1);
301 Eterm* bigp = HAlloc(BIF_P, need);
302
303 ret = big_bnot(BIF_ARG_1, bigp);
304 maybe_shrink(BIF_P, bigp, ret, need);
305 if (is_nil(ret)) {
306 BIF_ERROR(BIF_P, SYSTEM_LIMIT);
307 }
308 } else {
309 BIF_ERROR(BIF_P, BADARITH);
310 }
311 BIF_RET(ret);
312 }
313
314 /*
315 * Implementation and interfaces for the rest of the runtime system.
316 * The functions that follow are only used in match specs and when
317 * arithmetic functions are applied.
318 */
319
320 Eterm
erts_mixed_plus(Process * p,Eterm arg1,Eterm arg2)321 erts_mixed_plus(Process* p, Eterm arg1, Eterm arg2)
322 {
323 DECLARE_TMP(tmp_big1,0,p);
324 DECLARE_TMP(tmp_big2,1,p);
325 Eterm res;
326 Eterm hdr;
327 FloatDef f1, f2;
328 dsize_t sz1, sz2, sz;
329 int need_heap;
330 Eterm* hp;
331 Sint ires;
332
333 ERTS_FP_CHECK_INIT(p);
334 switch (arg1 & _TAG_PRIMARY_MASK) {
335 case TAG_PRIMARY_IMMED1:
336 switch ((arg1 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
337 case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
338 switch (arg2 & _TAG_PRIMARY_MASK) {
339 case TAG_PRIMARY_IMMED1:
340 switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
341 case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
342 ires = signed_val(arg1) + signed_val(arg2);
343 if (IS_SSMALL(ires)) {
344 return make_small(ires);
345 } else {
346 hp = HAlloc(p, 2);
347 res = small_to_big(ires, hp);
348 return res;
349 }
350 default:
351 badarith:
352 p->freason = BADARITH;
353 return THE_NON_VALUE;
354 }
355 case TAG_PRIMARY_BOXED:
356 hdr = *boxed_val(arg2);
357 switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
358 case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
359 case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
360 if (arg1 == SMALL_ZERO) {
361 return arg2;
362 }
363 arg1 = small_to_big(signed_val(arg1), tmp_big1);
364 goto do_big;
365 case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
366 f1.fd = signed_val(arg1);
367 GET_DOUBLE(arg2, f2);
368 goto do_float;
369 default:
370 goto badarith;
371 }
372 }
373 default:
374 goto badarith;
375 }
376 case TAG_PRIMARY_BOXED:
377 hdr = *boxed_val(arg1);
378 switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
379 case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
380 case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
381 switch (arg2 & _TAG_PRIMARY_MASK) {
382 case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
383 switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
384 case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
385 if (arg2 == SMALL_ZERO) {
386 return arg1;
387 }
388 arg2 = small_to_big(signed_val(arg2), tmp_big2);
389 goto do_big;
390 default:
391 goto badarith;
392 }
393 case TAG_PRIMARY_BOXED:
394 hdr = *boxed_val(arg2);
395 switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
396 case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
397 case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
398 do_big:
399 sz1 = big_size(arg1);
400 sz2 = big_size(arg2);
401 sz = MAX(sz1, sz2)+1;
402 need_heap = BIG_NEED_SIZE(sz);
403 hp = HAlloc(p, need_heap);
404 res = big_plus(arg1, arg2, hp);
405 maybe_shrink(p, hp, res, need_heap);
406 if (is_nil(res)) {
407 p->freason = SYSTEM_LIMIT;
408 return THE_NON_VALUE;
409 }
410 return res;
411 case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
412 if (big_to_double(arg1, &f1.fd) < 0) {
413 goto badarith;
414 }
415 GET_DOUBLE(arg2, f2);
416 goto do_float;
417 default:
418 goto badarith;
419 }
420 }
421 case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
422 switch (arg2 & _TAG_PRIMARY_MASK) {
423 case TAG_PRIMARY_IMMED1:
424 switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
425 case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
426 GET_DOUBLE(arg1, f1);
427 f2.fd = signed_val(arg2);
428 goto do_float;
429 default:
430 goto badarith;
431 }
432 case TAG_PRIMARY_BOXED:
433 hdr = *boxed_val(arg2);
434 switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
435 case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
436 case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
437 GET_DOUBLE(arg1, f1);
438 if (big_to_double(arg2, &f2.fd) < 0) {
439 goto badarith;
440 }
441 goto do_float;
442 case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
443 GET_DOUBLE(arg1, f1);
444 GET_DOUBLE(arg2, f2);
445
446 do_float:
447 f1.fd = f1.fd + f2.fd;
448 ERTS_FP_ERROR(p, f1.fd, goto badarith);
449 hp = HAlloc(p, FLOAT_SIZE_OBJECT);
450 res = make_float(hp);
451 PUT_DOUBLE(f1, hp);
452 return res;
453 default:
454 goto badarith;
455 }
456 default:
457 goto badarith;
458 }
459 }
460 default:
461 goto badarith;
462 }
463 }
464
465 Eterm
erts_mixed_minus(Process * p,Eterm arg1,Eterm arg2)466 erts_mixed_minus(Process* p, Eterm arg1, Eterm arg2)
467 {
468 DECLARE_TMP(tmp_big1,0,p);
469 DECLARE_TMP(tmp_big2,1,p);
470 Eterm hdr;
471 Eterm res;
472 FloatDef f1, f2;
473 dsize_t sz1, sz2, sz;
474 int need_heap;
475 Eterm* hp;
476 Sint ires;
477
478 ERTS_FP_CHECK_INIT(p);
479 switch (arg1 & _TAG_PRIMARY_MASK) {
480 case TAG_PRIMARY_IMMED1:
481 switch ((arg1 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
482 case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
483 switch (arg2 & _TAG_PRIMARY_MASK) {
484 case TAG_PRIMARY_IMMED1:
485 switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
486 case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
487 ires = signed_val(arg1) - signed_val(arg2);
488 if (IS_SSMALL(ires)) {
489 return make_small(ires);
490 } else {
491 hp = HAlloc(p, 2);
492 res = small_to_big(ires, hp);
493 return res;
494 }
495 default:
496 badarith:
497 p->freason = BADARITH;
498 return THE_NON_VALUE;
499 }
500 case TAG_PRIMARY_BOXED:
501 hdr = *boxed_val(arg2);
502 switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
503 case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
504 case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
505 arg1 = small_to_big(signed_val(arg1), tmp_big1);
506 goto do_big;
507 case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
508 f1.fd = signed_val(arg1);
509 GET_DOUBLE(arg2, f2);
510 goto do_float;
511 default:
512 goto badarith;
513 }
514 }
515 default:
516 goto badarith;
517 }
518 case TAG_PRIMARY_BOXED:
519 hdr = *boxed_val(arg1);
520 switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
521 case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
522 case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
523 switch (arg2 & _TAG_PRIMARY_MASK) {
524 case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
525 switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
526 case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
527 if (arg2 == SMALL_ZERO) {
528 return arg1;
529 }
530 arg2 = small_to_big(signed_val(arg2), tmp_big2);
531
532 do_big:
533 sz1 = big_size(arg1);
534 sz2 = big_size(arg2);
535 sz = MAX(sz1, sz2)+1;
536 need_heap = BIG_NEED_SIZE(sz);
537 hp = HAlloc(p, need_heap);
538 res = big_minus(arg1, arg2, hp);
539 maybe_shrink(p, hp, res, need_heap);
540 if (is_nil(res)) {
541 p->freason = SYSTEM_LIMIT;
542 return THE_NON_VALUE;
543 }
544 return res;
545 default:
546 goto badarith;
547 }
548 case TAG_PRIMARY_BOXED:
549 hdr = *boxed_val(arg2);
550 switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
551 case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
552 case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
553 goto do_big;
554 case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
555 if (big_to_double(arg1, &f1.fd) < 0) {
556 goto badarith;
557 }
558 GET_DOUBLE(arg2, f2);
559 goto do_float;
560 default:
561 goto badarith;
562 }
563 }
564 case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
565 switch (arg2 & _TAG_PRIMARY_MASK) {
566 case TAG_PRIMARY_IMMED1:
567 switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
568 case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
569 GET_DOUBLE(arg1, f1);
570 f2.fd = signed_val(arg2);
571 goto do_float;
572 default:
573 goto badarith;
574 }
575 case TAG_PRIMARY_BOXED:
576 hdr = *boxed_val(arg2);
577 switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
578 case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
579 case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
580 GET_DOUBLE(arg1, f1);
581 if (big_to_double(arg2, &f2.fd) < 0) {
582 goto badarith;
583 }
584 goto do_float;
585 case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
586 GET_DOUBLE(arg1, f1);
587 GET_DOUBLE(arg2, f2);
588
589 do_float:
590 f1.fd = f1.fd - f2.fd;
591 ERTS_FP_ERROR(p, f1.fd, goto badarith);
592 hp = HAlloc(p, FLOAT_SIZE_OBJECT);
593 res = make_float(hp);
594 PUT_DOUBLE(f1, hp);
595 return res;
596 default:
597 goto badarith;
598 }
599 default:
600 goto badarith;
601 }
602 }
603 default:
604 goto badarith;
605 }
606 }
607
608 Eterm
erts_mixed_times(Process * p,Eterm arg1,Eterm arg2)609 erts_mixed_times(Process* p, Eterm arg1, Eterm arg2)
610 {
611 DECLARE_TMP(tmp_big1,0,p);
612 DECLARE_TMP(tmp_big2,1,p);
613 Eterm hdr;
614 Eterm res;
615 FloatDef f1, f2;
616 dsize_t sz1, sz2, sz;
617 int need_heap;
618 Eterm* hp;
619
620 ERTS_FP_CHECK_INIT(p);
621 switch (arg1 & _TAG_PRIMARY_MASK) {
622 case TAG_PRIMARY_IMMED1:
623 switch ((arg1 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
624 case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
625 switch (arg2 & _TAG_PRIMARY_MASK) {
626 case TAG_PRIMARY_IMMED1:
627 switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
628 case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
629 if ((arg1 == SMALL_ZERO) || (arg2 == SMALL_ZERO)) {
630 return(SMALL_ZERO);
631 } else if (arg1 == SMALL_ONE) {
632 return(arg2);
633 } else if (arg2 == SMALL_ONE) {
634 return(arg1);
635 } else {
636 DeclareTmpHeap(big_res,3,p);
637 UseTmpHeap(3,p);
638 /*
639 * The following code is optimized for the case that
640 * result is small (which should be the most common case
641 * in practice).
642 */
643 res = small_times(signed_val(arg1), signed_val(arg2), big_res);
644 if (is_small(res)) {
645 UnUseTmpHeap(3,p);
646 return res;
647 } else {
648 /*
649 * The result is a a big number.
650 * Allocate a heap fragment and copy the result.
651 * Be careful to allocate exactly what we need
652 * to not leave any holes.
653 */
654 Uint arity;
655
656 ASSERT(is_big(res));
657 hdr = big_res[0];
658 arity = bignum_header_arity(hdr);
659 ASSERT(arity == 1 || arity == 2);
660 hp = HAlloc(p, arity+1);
661 res = make_big(hp);
662 *hp++ = hdr;
663 *hp++ = big_res[1];
664 if (arity > 1) {
665 *hp = big_res[2];
666 }
667 UnUseTmpHeap(3,p);
668 return res;
669 }
670 }
671 default:
672 badarith:
673 p->freason = BADARITH;
674 return THE_NON_VALUE;
675 }
676 case TAG_PRIMARY_BOXED:
677 hdr = *boxed_val(arg2);
678 switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
679 case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
680 case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
681 if (arg1 == SMALL_ZERO)
682 return(SMALL_ZERO);
683 if (arg1 == SMALL_ONE)
684 return(arg2);
685 arg1 = small_to_big(signed_val(arg1), tmp_big1);
686 sz = 2 + big_size(arg2);
687 goto do_big;
688 case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
689 f1.fd = signed_val(arg1);
690 GET_DOUBLE(arg2, f2);
691 goto do_float;
692 default:
693 goto badarith;
694 }
695 }
696 default:
697 goto badarith;
698 }
699 case TAG_PRIMARY_BOXED:
700 hdr = *boxed_val(arg1);
701 switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
702 case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
703 case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
704 switch (arg2 & _TAG_PRIMARY_MASK) {
705 case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
706 switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
707 case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
708 if (arg2 == SMALL_ZERO)
709 return(SMALL_ZERO);
710 if (arg2 == SMALL_ONE)
711 return(arg1);
712 arg2 = small_to_big(signed_val(arg2), tmp_big2);
713 sz = 2 + big_size(arg1);
714 goto do_big;
715 default:
716 goto badarith;
717 }
718 case TAG_PRIMARY_BOXED:
719 hdr = *boxed_val(arg2);
720 switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
721 case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
722 case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
723 sz1 = big_size(arg1);
724 sz2 = big_size(arg2);
725 sz = sz1 + sz2;
726
727 do_big:
728 need_heap = BIG_NEED_SIZE(sz);
729 hp = HAlloc(p, need_heap);
730 res = big_times(arg1, arg2, hp);
731
732 /*
733 * Note that the result must be big in this case, since
734 * at least one operand was big to begin with, and
735 * the absolute value of the other is > 1.
736 */
737
738 maybe_shrink(p, hp, res, need_heap);
739 if (is_nil(res)) {
740 p->freason = SYSTEM_LIMIT;
741 return THE_NON_VALUE;
742 }
743 return res;
744 case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
745 if (big_to_double(arg1, &f1.fd) < 0) {
746 goto badarith;
747 }
748 GET_DOUBLE(arg2, f2);
749 goto do_float;
750 default:
751 goto badarith;
752 }
753 }
754 case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
755 switch (arg2 & _TAG_PRIMARY_MASK) {
756 case TAG_PRIMARY_IMMED1:
757 switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
758 case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
759 GET_DOUBLE(arg1, f1);
760 f2.fd = signed_val(arg2);
761 goto do_float;
762 default:
763 goto badarith;
764 }
765 case TAG_PRIMARY_BOXED:
766 hdr = *boxed_val(arg2);
767 switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
768 case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
769 case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
770 GET_DOUBLE(arg1, f1);
771 if (big_to_double(arg2, &f2.fd) < 0) {
772 goto badarith;
773 }
774 goto do_float;
775 case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
776 GET_DOUBLE(arg1, f1);
777 GET_DOUBLE(arg2, f2);
778
779 do_float:
780 f1.fd = f1.fd * f2.fd;
781 ERTS_FP_ERROR(p, f1.fd, goto badarith);
782 hp = HAlloc(p, FLOAT_SIZE_OBJECT);
783 res = make_float(hp);
784 PUT_DOUBLE(f1, hp);
785 return res;
786 default:
787 goto badarith;
788 }
789 default:
790 goto badarith;
791 }
792 }
793 default:
794 goto badarith;
795 }
796 }
797
798 Eterm
erts_mixed_div(Process * p,Eterm arg1,Eterm arg2)799 erts_mixed_div(Process* p, Eterm arg1, Eterm arg2)
800 {
801 FloatDef f1, f2;
802 Eterm* hp;
803 Eterm hdr;
804
805 ERTS_FP_CHECK_INIT(p);
806 switch (arg1 & _TAG_PRIMARY_MASK) {
807 case TAG_PRIMARY_IMMED1:
808 switch ((arg1 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
809 case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
810 switch (arg2 & _TAG_PRIMARY_MASK) {
811 case TAG_PRIMARY_IMMED1:
812 switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
813 case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
814 f1.fd = signed_val(arg1);
815 f2.fd = signed_val(arg2);
816 goto do_float;
817 default:
818 badarith:
819 p->freason = BADARITH;
820 return THE_NON_VALUE;
821 }
822 case TAG_PRIMARY_BOXED:
823 hdr = *boxed_val(arg2);
824 switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
825 case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
826 case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
827 f1.fd = signed_val(arg1);
828 if (big_to_double(arg2, &f2.fd) < 0) {
829 goto badarith;
830 }
831 goto do_float;
832 case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
833 f1.fd = signed_val(arg1);
834 GET_DOUBLE(arg2, f2);
835 goto do_float;
836 default:
837 goto badarith;
838 }
839 }
840 default:
841 goto badarith;
842 }
843 case TAG_PRIMARY_BOXED:
844 hdr = *boxed_val(arg1);
845 switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
846 case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
847 case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
848 switch (arg2 & _TAG_PRIMARY_MASK) {
849 case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
850 switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
851 case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
852 if (big_to_double(arg1, &f1.fd) < 0) {
853 goto badarith;
854 }
855 f2.fd = signed_val(arg2);
856 goto do_float;
857 default:
858 goto badarith;
859 }
860 case TAG_PRIMARY_BOXED:
861 hdr = *boxed_val(arg2);
862 switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
863 case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
864 case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
865 if (big_to_double(arg1, &f1.fd) < 0 ||
866 big_to_double(arg2, &f2.fd) < 0) {
867 goto badarith;
868 }
869 goto do_float;
870 case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
871 if (big_to_double(arg1, &f1.fd) < 0) {
872 goto badarith;
873 }
874 GET_DOUBLE(arg2, f2);
875 goto do_float;
876 default:
877 goto badarith;
878 }
879 }
880 case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
881 switch (arg2 & _TAG_PRIMARY_MASK) {
882 case TAG_PRIMARY_IMMED1:
883 switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
884 case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
885 GET_DOUBLE(arg1, f1);
886 f2.fd = signed_val(arg2);
887 goto do_float;
888 default:
889 goto badarith;
890 }
891 case TAG_PRIMARY_BOXED:
892 hdr = *boxed_val(arg2);
893 switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
894 case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
895 case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
896 GET_DOUBLE(arg1, f1);
897 if (big_to_double(arg2, &f2.fd) < 0) {
898 goto badarith;
899 }
900 goto do_float;
901 case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
902 GET_DOUBLE(arg1, f1);
903 GET_DOUBLE(arg2, f2);
904
905 do_float:
906 f1.fd = f1.fd / f2.fd;
907 ERTS_FP_ERROR(p, f1.fd, goto badarith);
908 hp = HAlloc(p, FLOAT_SIZE_OBJECT);
909 PUT_DOUBLE(f1, hp);
910 return make_float(hp);
911 default:
912 goto badarith;
913 }
914 default:
915 goto badarith;
916 }
917 }
918 default:
919 goto badarith;
920 }
921 }
922
923 Eterm
erts_int_div(Process * p,Eterm arg1,Eterm arg2)924 erts_int_div(Process* p, Eterm arg1, Eterm arg2)
925 {
926 DECLARE_TMP(tmp_big1,0,p);
927 DECLARE_TMP(tmp_big2,1,p);
928 int ires;
929
930 switch (NUMBER_CODE(arg1, arg2)) {
931 case SMALL_SMALL:
932 /* This case occurs if the most negative fixnum is divided by -1. */
933 ASSERT(arg2 == make_small(-1));
934 arg1 = small_to_big(signed_val(arg1), tmp_big1);
935 /*FALLTHROUGH*/
936 case BIG_SMALL:
937 arg2 = small_to_big(signed_val(arg2), tmp_big2);
938 goto L_big_div;
939 case SMALL_BIG:
940 if (arg1 != make_small(MIN_SMALL)) {
941 return SMALL_ZERO;
942 }
943 arg1 = small_to_big(signed_val(arg1), tmp_big1);
944 /*FALLTHROUGH*/
945 case BIG_BIG:
946 L_big_div:
947 ires = big_ucomp(arg1, arg2);
948 if (ires < 0) {
949 arg1 = SMALL_ZERO;
950 } else if (ires == 0) {
951 arg1 = (big_sign(arg1) == big_sign(arg2)) ?
952 SMALL_ONE : SMALL_MINUS_ONE;
953 } else {
954 Eterm* hp;
955 int i = big_size(arg1);
956 Uint need;
957
958 ires = big_size(arg2);
959 need = BIG_NEED_SIZE(i-ires+1) + BIG_NEED_SIZE(i);
960 hp = HAlloc(p, need);
961 arg1 = big_div(arg1, arg2, hp);
962 maybe_shrink(p, hp, arg1, need);
963 if (is_nil(arg1)) {
964 p->freason = SYSTEM_LIMIT;
965 return THE_NON_VALUE;
966 }
967 }
968 return arg1;
969 default:
970 p->freason = BADARITH;
971 return THE_NON_VALUE;
972 }
973 }
974
975 Eterm
erts_int_rem(Process * p,Eterm arg1,Eterm arg2)976 erts_int_rem(Process* p, Eterm arg1, Eterm arg2)
977 {
978 DECLARE_TMP(tmp_big1,0,p);
979 DECLARE_TMP(tmp_big2,1,p);
980 int ires;
981
982 switch (NUMBER_CODE(arg1, arg2)) {
983 case BIG_SMALL:
984 arg2 = small_to_big(signed_val(arg2), tmp_big2);
985 goto L_big_rem;
986 case SMALL_BIG:
987 if (arg1 != make_small(MIN_SMALL)) {
988 return arg1;
989 } else {
990 Eterm tmp;
991 tmp = small_to_big(signed_val(arg1), tmp_big1);
992 if ((ires = big_ucomp(tmp, arg2)) == 0) {
993 return SMALL_ZERO;
994 } else {
995 ASSERT(ires < 0);
996 return arg1;
997 }
998 }
999 /* All paths returned */
1000 case BIG_BIG:
1001 L_big_rem:
1002 ires = big_ucomp(arg1, arg2);
1003 if (ires == 0) {
1004 arg1 = SMALL_ZERO;
1005 } else if (ires > 0) {
1006 Uint need = BIG_NEED_SIZE(big_size(arg1));
1007 Eterm* hp = HAlloc(p, need);
1008
1009 arg1 = big_rem(arg1, arg2, hp);
1010 maybe_shrink(p, hp, arg1, need);
1011 if (is_nil(arg1)) {
1012 p->freason = SYSTEM_LIMIT;
1013 return THE_NON_VALUE;
1014 }
1015 }
1016 return arg1;
1017 default:
1018 p->freason = BADARITH;
1019 return THE_NON_VALUE;
1020 }
1021 }
1022
erts_band(Process * p,Eterm arg1,Eterm arg2)1023 Eterm erts_band(Process* p, Eterm arg1, Eterm arg2)
1024 {
1025 DECLARE_TMP(tmp_big1,0,p);
1026 DECLARE_TMP(tmp_big2,1,p);
1027 Eterm* hp;
1028 int need;
1029
1030 switch (NUMBER_CODE(arg1, arg2)) {
1031 case SMALL_BIG:
1032 arg1 = small_to_big(signed_val(arg1), tmp_big1);
1033 break;
1034 case BIG_SMALL:
1035 arg2 = small_to_big(signed_val(arg2), tmp_big2);
1036 break;
1037 case BIG_BIG:
1038 break;
1039 default:
1040 p->freason = BADARITH;
1041 return THE_NON_VALUE;
1042 }
1043 need = BIG_NEED_SIZE(MAX(big_size(arg1), big_size(arg2)) + 1);
1044 hp = HAlloc(p, need);
1045 arg1 = big_band(arg1, arg2, hp);
1046 ASSERT(is_not_nil(arg1));
1047 maybe_shrink(p, hp, arg1, need);
1048 return arg1;
1049 }
1050
erts_bor(Process * p,Eterm arg1,Eterm arg2)1051 Eterm erts_bor(Process* p, Eterm arg1, Eterm arg2)
1052 {
1053 DECLARE_TMP(tmp_big1,0,p);
1054 DECLARE_TMP(tmp_big2,1,p);
1055 Eterm* hp;
1056 int need;
1057
1058 switch (NUMBER_CODE(arg1, arg2)) {
1059 case SMALL_BIG:
1060 arg1 = small_to_big(signed_val(arg1), tmp_big1);
1061 break;
1062 case BIG_SMALL:
1063 arg2 = small_to_big(signed_val(arg2), tmp_big2);
1064 break;
1065 case BIG_BIG:
1066 break;
1067 default:
1068 p->freason = BADARITH;
1069 return THE_NON_VALUE;
1070 }
1071 need = BIG_NEED_SIZE(MAX(big_size(arg1), big_size(arg2)) + 1);
1072 hp = HAlloc(p, need);
1073 arg1 = big_bor(arg1, arg2, hp);
1074 ASSERT(is_not_nil(arg1));
1075 maybe_shrink(p, hp, arg1, need);
1076 return arg1;
1077 }
1078
erts_bxor(Process * p,Eterm arg1,Eterm arg2)1079 Eterm erts_bxor(Process* p, Eterm arg1, Eterm arg2)
1080 {
1081 DECLARE_TMP(tmp_big1,0,p);
1082 DECLARE_TMP(tmp_big2,1,p);
1083 Eterm* hp;
1084 int need;
1085
1086 switch (NUMBER_CODE(arg1, arg2)) {
1087 case SMALL_BIG:
1088 arg1 = small_to_big(signed_val(arg1), tmp_big1);
1089 break;
1090 case BIG_SMALL:
1091 arg2 = small_to_big(signed_val(arg2), tmp_big2);
1092 break;
1093 case BIG_BIG:
1094 break;
1095 default:
1096 p->freason = BADARITH;
1097 return THE_NON_VALUE;
1098 }
1099 need = BIG_NEED_SIZE(MAX(big_size(arg1), big_size(arg2)) + 1);
1100 hp = HAlloc(p, need);
1101 arg1 = big_bxor(arg1, arg2, hp);
1102 ASSERT(is_not_nil(arg1));
1103 maybe_shrink(p, hp, arg1, need);
1104 return arg1;
1105 }
1106
erts_bnot(Process * p,Eterm arg)1107 Eterm erts_bnot(Process* p, Eterm arg)
1108 {
1109 Eterm ret;
1110
1111 if (is_big(arg)) {
1112 Uint need = BIG_NEED_SIZE(big_size(arg)+1);
1113 Eterm* bigp = HAlloc(p, need);
1114
1115 ret = big_bnot(arg, bigp);
1116 maybe_shrink(p, bigp, ret, need);
1117 if (is_nil(ret)) {
1118 p->freason = SYSTEM_LIMIT;
1119 return NIL;
1120 }
1121 } else {
1122 p->freason = BADARITH;
1123 return NIL;
1124 }
1125 return ret;
1126 }
1127
1128 #define ERTS_NEED_GC(p, need) ((HEAP_LIMIT((p)) - HEAP_TOP((p))) <= (need))
1129
1130 static ERTS_INLINE void
trim_heap(Process * p,Eterm * hp,Eterm res)1131 trim_heap(Process* p, Eterm* hp, Eterm res)
1132 {
1133 if (is_immed(res)) {
1134 ASSERT(p->heap <= hp && hp <= p->htop);
1135 p->htop = hp;
1136 } else {
1137 Eterm* new_htop;
1138 ASSERT(is_big(res));
1139 new_htop = hp + bignum_header_arity(*hp) + 1;
1140 ASSERT(p->heap <= new_htop && new_htop <= p->htop);
1141 p->htop = new_htop;
1142 }
1143 ASSERT(p->heap <= p->htop && p->htop <= p->stop);
1144 }
1145
1146 /*
1147 * The functions that follow are called from the emulator loop.
1148 * They are not allowed to allocate heap fragments, but must do
1149 * a garbage collection if there is insufficient heap space.
1150 */
1151
1152 #define erts_heap_frag_shrink horrible error
1153 #define maybe_shrink horrible error
1154
1155 Eterm
erts_gc_mixed_plus(Process * p,Eterm * reg,Uint live)1156 erts_gc_mixed_plus(Process* p, Eterm* reg, Uint live)
1157 {
1158 Eterm arg1;
1159 Eterm arg2;
1160 DECLARE_TMP(tmp_big1,0,p);
1161 DECLARE_TMP(tmp_big2,1,p);
1162 Eterm res;
1163 Eterm hdr;
1164 FloatDef f1, f2;
1165 dsize_t sz1, sz2, sz;
1166 int need_heap;
1167 Eterm* hp;
1168 Sint ires;
1169
1170 arg1 = reg[live];
1171 arg2 = reg[live+1];
1172 ERTS_FP_CHECK_INIT(p);
1173 switch (arg1 & _TAG_PRIMARY_MASK) {
1174 case TAG_PRIMARY_IMMED1:
1175 switch ((arg1 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
1176 case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
1177 switch (arg2 & _TAG_PRIMARY_MASK) {
1178 case TAG_PRIMARY_IMMED1:
1179 switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
1180 case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
1181 ires = signed_val(arg1) + signed_val(arg2);
1182 if (IS_SSMALL(ires)) {
1183 return make_small(ires);
1184 } else {
1185 if (ERTS_NEED_GC(p, 2)) {
1186 erts_garbage_collect(p, 2, reg, live);
1187 }
1188 hp = p->htop;
1189 p->htop += 2;
1190 res = small_to_big(ires, hp);
1191 return res;
1192 }
1193 default:
1194 badarith:
1195 p->freason = BADARITH;
1196 return THE_NON_VALUE;
1197 }
1198 case TAG_PRIMARY_BOXED:
1199 hdr = *boxed_val(arg2);
1200 switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
1201 case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
1202 case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
1203 if (arg1 == SMALL_ZERO) {
1204 return arg2;
1205 }
1206 arg1 = small_to_big(signed_val(arg1), tmp_big1);
1207 goto do_big;
1208 case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
1209 f1.fd = signed_val(arg1);
1210 GET_DOUBLE(arg2, f2);
1211 goto do_float;
1212 default:
1213 goto badarith;
1214 }
1215 }
1216 default:
1217 goto badarith;
1218 }
1219 case TAG_PRIMARY_BOXED:
1220 hdr = *boxed_val(arg1);
1221 switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
1222 case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
1223 case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
1224 switch (arg2 & _TAG_PRIMARY_MASK) {
1225 case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
1226 switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
1227 case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
1228 if (arg2 == SMALL_ZERO) {
1229 return arg1;
1230 }
1231 arg2 = small_to_big(signed_val(arg2), tmp_big2);
1232 goto do_big;
1233 default:
1234 goto badarith;
1235 }
1236 case TAG_PRIMARY_BOXED:
1237 hdr = *boxed_val(arg2);
1238 switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
1239 case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
1240 case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
1241 do_big:
1242 sz1 = big_size(arg1);
1243 sz2 = big_size(arg2);
1244 sz = MAX(sz1, sz2)+1;
1245 need_heap = BIG_NEED_SIZE(sz);
1246 if (ERTS_NEED_GC(p, need_heap)) {
1247 erts_garbage_collect(p, need_heap, reg, live+2);
1248 if (ARG_IS_NOT_TMP(arg1,tmp_big1)) {
1249 arg1 = reg[live];
1250 }
1251 if (ARG_IS_NOT_TMP(arg2,tmp_big2)) {
1252 arg2 = reg[live+1];
1253 }
1254 }
1255 hp = p->htop;
1256 p->htop += need_heap;
1257 res = big_plus(arg1, arg2, hp);
1258 trim_heap(p, hp, res);
1259 if (is_nil(res)) {
1260 p->freason = SYSTEM_LIMIT;
1261 return THE_NON_VALUE;
1262 }
1263 return res;
1264 case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
1265 if (big_to_double(arg1, &f1.fd) < 0) {
1266 goto badarith;
1267 }
1268 GET_DOUBLE(arg2, f2);
1269 goto do_float;
1270 default:
1271 goto badarith;
1272 }
1273 }
1274 case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
1275 switch (arg2 & _TAG_PRIMARY_MASK) {
1276 case TAG_PRIMARY_IMMED1:
1277 switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
1278 case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
1279 GET_DOUBLE(arg1, f1);
1280 f2.fd = signed_val(arg2);
1281 goto do_float;
1282 default:
1283 goto badarith;
1284 }
1285 case TAG_PRIMARY_BOXED:
1286 hdr = *boxed_val(arg2);
1287 switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
1288 case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
1289 case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
1290 GET_DOUBLE(arg1, f1);
1291 if (big_to_double(arg2, &f2.fd) < 0) {
1292 goto badarith;
1293 }
1294 goto do_float;
1295 case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
1296 GET_DOUBLE(arg1, f1);
1297 GET_DOUBLE(arg2, f2);
1298
1299 do_float:
1300 f1.fd = f1.fd + f2.fd;
1301 ERTS_FP_ERROR(p, f1.fd, goto badarith);
1302 if (ERTS_NEED_GC(p, FLOAT_SIZE_OBJECT)) {
1303 erts_garbage_collect(p, FLOAT_SIZE_OBJECT, reg, live);
1304 }
1305 hp = p->htop;
1306 p->htop += FLOAT_SIZE_OBJECT;
1307 res = make_float(hp);
1308 PUT_DOUBLE(f1, hp);
1309 return res;
1310 default:
1311 goto badarith;
1312 }
1313 default:
1314 goto badarith;
1315 }
1316 }
1317 default:
1318 goto badarith;
1319 }
1320 }
1321
1322 Eterm
erts_gc_mixed_minus(Process * p,Eterm * reg,Uint live)1323 erts_gc_mixed_minus(Process* p, Eterm* reg, Uint live)
1324 {
1325 Eterm arg1;
1326 Eterm arg2;
1327 DECLARE_TMP(tmp_big1,0,p);
1328 DECLARE_TMP(tmp_big2,1,p);
1329 Eterm hdr;
1330 Eterm res;
1331 FloatDef f1, f2;
1332 dsize_t sz1, sz2, sz;
1333 int need_heap;
1334 Eterm* hp;
1335 Sint ires;
1336
1337 arg1 = reg[live];
1338 arg2 = reg[live+1];
1339 ERTS_FP_CHECK_INIT(p);
1340 switch (arg1 & _TAG_PRIMARY_MASK) {
1341 case TAG_PRIMARY_IMMED1:
1342 switch ((arg1 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
1343 case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
1344 switch (arg2 & _TAG_PRIMARY_MASK) {
1345 case TAG_PRIMARY_IMMED1:
1346 switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
1347 case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
1348 ires = signed_val(arg1) - signed_val(arg2);
1349 if (IS_SSMALL(ires)) {
1350 return make_small(ires);
1351 } else {
1352 if (ERTS_NEED_GC(p, 2)) {
1353 erts_garbage_collect(p, 2, reg, live);
1354 }
1355 hp = p->htop;
1356 p->htop += 2;
1357 res = small_to_big(ires, hp);
1358 return res;
1359 }
1360 default:
1361 badarith:
1362 p->freason = BADARITH;
1363 return THE_NON_VALUE;
1364 }
1365 case TAG_PRIMARY_BOXED:
1366 hdr = *boxed_val(arg2);
1367 switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
1368 case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
1369 case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
1370 arg1 = small_to_big(signed_val(arg1), tmp_big1);
1371 goto do_big;
1372 case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
1373 f1.fd = signed_val(arg1);
1374 GET_DOUBLE(arg2, f2);
1375 goto do_float;
1376 default:
1377 goto badarith;
1378 }
1379 }
1380 default:
1381 goto badarith;
1382 }
1383 case TAG_PRIMARY_BOXED:
1384 hdr = *boxed_val(arg1);
1385 switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
1386 case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
1387 case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
1388 switch (arg2 & _TAG_PRIMARY_MASK) {
1389 case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
1390 switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
1391 case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
1392 if (arg2 == SMALL_ZERO) {
1393 return arg1;
1394 }
1395 arg2 = small_to_big(signed_val(arg2), tmp_big2);
1396
1397 do_big:
1398 sz1 = big_size(arg1);
1399 sz2 = big_size(arg2);
1400 sz = MAX(sz1, sz2)+1;
1401 need_heap = BIG_NEED_SIZE(sz);
1402 if (ERTS_NEED_GC(p, need_heap)) {
1403 erts_garbage_collect(p, need_heap, reg, live+2);
1404 if (ARG_IS_NOT_TMP(arg1,tmp_big1)) {
1405 arg1 = reg[live];
1406 }
1407 if (ARG_IS_NOT_TMP(arg2,tmp_big2)) {
1408 arg2 = reg[live+1];
1409 }
1410 }
1411 hp = p->htop;
1412 p->htop += need_heap;
1413 res = big_minus(arg1, arg2, hp);
1414 trim_heap(p, hp, res);
1415 if (is_nil(res)) {
1416 p->freason = SYSTEM_LIMIT;
1417 return THE_NON_VALUE;
1418 }
1419 return res;
1420 default:
1421 goto badarith;
1422 }
1423 case TAG_PRIMARY_BOXED:
1424 hdr = *boxed_val(arg2);
1425 switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
1426 case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
1427 case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
1428 goto do_big;
1429 case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
1430 if (big_to_double(arg1, &f1.fd) < 0) {
1431 goto badarith;
1432 }
1433 GET_DOUBLE(arg2, f2);
1434 goto do_float;
1435 default:
1436 goto badarith;
1437 }
1438 }
1439 case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
1440 switch (arg2 & _TAG_PRIMARY_MASK) {
1441 case TAG_PRIMARY_IMMED1:
1442 switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
1443 case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
1444 GET_DOUBLE(arg1, f1);
1445 f2.fd = signed_val(arg2);
1446 goto do_float;
1447 default:
1448 goto badarith;
1449 }
1450 case TAG_PRIMARY_BOXED:
1451 hdr = *boxed_val(arg2);
1452 switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
1453 case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
1454 case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
1455 GET_DOUBLE(arg1, f1);
1456 if (big_to_double(arg2, &f2.fd) < 0) {
1457 goto badarith;
1458 }
1459 goto do_float;
1460 case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
1461 GET_DOUBLE(arg1, f1);
1462 GET_DOUBLE(arg2, f2);
1463
1464 do_float:
1465 f1.fd = f1.fd - f2.fd;
1466 ERTS_FP_ERROR(p, f1.fd, goto badarith);
1467 if (ERTS_NEED_GC(p, FLOAT_SIZE_OBJECT)) {
1468 erts_garbage_collect(p, FLOAT_SIZE_OBJECT, reg, live);
1469 }
1470 hp = p->htop;
1471 p->htop += FLOAT_SIZE_OBJECT;
1472 res = make_float(hp);
1473 PUT_DOUBLE(f1, hp);
1474 return res;
1475 default:
1476 goto badarith;
1477 }
1478 default:
1479 goto badarith;
1480 }
1481 }
1482 default:
1483 goto badarith;
1484 }
1485 }
1486
1487 Eterm
erts_gc_mixed_times(Process * p,Eterm * reg,Uint live)1488 erts_gc_mixed_times(Process* p, Eterm* reg, Uint live)
1489 {
1490 Eterm arg1;
1491 Eterm arg2;
1492 DECLARE_TMP(tmp_big1,0,p);
1493 DECLARE_TMP(tmp_big2,1,p);
1494 Eterm hdr;
1495 Eterm res;
1496 FloatDef f1, f2;
1497 dsize_t sz1, sz2, sz;
1498 int need_heap;
1499 Eterm* hp;
1500
1501 arg1 = reg[live];
1502 arg2 = reg[live+1];
1503 ERTS_FP_CHECK_INIT(p);
1504 switch (arg1 & _TAG_PRIMARY_MASK) {
1505 case TAG_PRIMARY_IMMED1:
1506 switch ((arg1 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
1507 case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
1508 switch (arg2 & _TAG_PRIMARY_MASK) {
1509 case TAG_PRIMARY_IMMED1:
1510 switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
1511 case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
1512 if ((arg1 == SMALL_ZERO) || (arg2 == SMALL_ZERO)) {
1513 return(SMALL_ZERO);
1514 } else if (arg1 == SMALL_ONE) {
1515 return(arg2);
1516 } else if (arg2 == SMALL_ONE) {
1517 return(arg1);
1518 } else {
1519 DeclareTmpHeap(big_res,3,p);
1520 UseTmpHeap(3,p);
1521
1522 /*
1523 * The following code is optimized for the case that
1524 * result is small (which should be the most common case
1525 * in practice).
1526 */
1527 res = small_times(signed_val(arg1), signed_val(arg2),
1528 big_res);
1529 if (is_small(res)) {
1530 UnUseTmpHeap(3,p);
1531 return res;
1532 } else {
1533 /*
1534 * The result is a a big number.
1535 * Allocate a heap fragment and copy the result.
1536 * Be careful to allocate exactly what we need
1537 * to not leave any holes.
1538 */
1539 Uint arity;
1540 Uint need;
1541
1542 ASSERT(is_big(res));
1543 hdr = big_res[0];
1544 arity = bignum_header_arity(hdr);
1545 ASSERT(arity == 1 || arity == 2);
1546 need = arity + 1;
1547 if (ERTS_NEED_GC(p, need)) {
1548 erts_garbage_collect(p, need, reg, live);
1549 }
1550 hp = p->htop;
1551 p->htop += need;
1552 res = make_big(hp);
1553 *hp++ = hdr;
1554 *hp++ = big_res[1];
1555 if (arity > 1) {
1556 *hp = big_res[2];
1557 }
1558 UnUseTmpHeap(3,p);
1559 return res;
1560 }
1561 }
1562 default:
1563 badarith:
1564 p->freason = BADARITH;
1565 return THE_NON_VALUE;
1566 }
1567 case TAG_PRIMARY_BOXED:
1568 hdr = *boxed_val(arg2);
1569 switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
1570 case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
1571 case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
1572 if (arg1 == SMALL_ZERO)
1573 return(SMALL_ZERO);
1574 if (arg1 == SMALL_ONE)
1575 return(arg2);
1576 arg1 = small_to_big(signed_val(arg1), tmp_big1);
1577 sz = 2 + big_size(arg2);
1578 goto do_big;
1579 case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
1580 f1.fd = signed_val(arg1);
1581 GET_DOUBLE(arg2, f2);
1582 goto do_float;
1583 default:
1584 goto badarith;
1585 }
1586 }
1587 default:
1588 goto badarith;
1589 }
1590 case TAG_PRIMARY_BOXED:
1591 hdr = *boxed_val(arg1);
1592 switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
1593 case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
1594 case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
1595 switch (arg2 & _TAG_PRIMARY_MASK) {
1596 case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
1597 switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
1598 case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
1599 if (arg2 == SMALL_ZERO)
1600 return(SMALL_ZERO);
1601 if (arg2 == SMALL_ONE)
1602 return(arg1);
1603 arg2 = small_to_big(signed_val(arg2), tmp_big2);
1604 sz = 2 + big_size(arg1);
1605 goto do_big;
1606 default:
1607 goto badarith;
1608 }
1609 case TAG_PRIMARY_BOXED:
1610 hdr = *boxed_val(arg2);
1611 switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
1612 case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
1613 case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
1614 sz1 = big_size(arg1);
1615 sz2 = big_size(arg2);
1616 sz = sz1 + sz2;
1617
1618 do_big:
1619 need_heap = BIG_NEED_SIZE(sz);
1620 if (ERTS_NEED_GC(p, need_heap)) {
1621 erts_garbage_collect(p, need_heap, reg, live+2);
1622 if (ARG_IS_NOT_TMP(arg1,tmp_big1)) {
1623 arg1 = reg[live];
1624 }
1625 if (ARG_IS_NOT_TMP(arg2,tmp_big2)) {
1626 arg2 = reg[live+1];
1627 }
1628 }
1629 hp = p->htop;
1630 p->htop += need_heap;
1631 res = big_times(arg1, arg2, hp);
1632 trim_heap(p, hp, res);
1633
1634 /*
1635 * Note that the result must be big in this case, since
1636 * at least one operand was big to begin with, and
1637 * the absolute value of the other is > 1.
1638 */
1639
1640 if (is_nil(res)) {
1641 p->freason = SYSTEM_LIMIT;
1642 return THE_NON_VALUE;
1643 }
1644 return res;
1645 case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
1646 if (big_to_double(arg1, &f1.fd) < 0) {
1647 goto badarith;
1648 }
1649 GET_DOUBLE(arg2, f2);
1650 goto do_float;
1651 default:
1652 goto badarith;
1653 }
1654 }
1655 case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
1656 switch (arg2 & _TAG_PRIMARY_MASK) {
1657 case TAG_PRIMARY_IMMED1:
1658 switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
1659 case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
1660 GET_DOUBLE(arg1, f1);
1661 f2.fd = signed_val(arg2);
1662 goto do_float;
1663 default:
1664 goto badarith;
1665 }
1666 case TAG_PRIMARY_BOXED:
1667 hdr = *boxed_val(arg2);
1668 switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
1669 case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
1670 case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
1671 GET_DOUBLE(arg1, f1);
1672 if (big_to_double(arg2, &f2.fd) < 0) {
1673 goto badarith;
1674 }
1675 goto do_float;
1676 case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
1677 GET_DOUBLE(arg1, f1);
1678 GET_DOUBLE(arg2, f2);
1679
1680 do_float:
1681 f1.fd = f1.fd * f2.fd;
1682 ERTS_FP_ERROR(p, f1.fd, goto badarith);
1683 if (ERTS_NEED_GC(p, FLOAT_SIZE_OBJECT)) {
1684 erts_garbage_collect(p, FLOAT_SIZE_OBJECT, reg, live);
1685 }
1686 hp = p->htop;
1687 p->htop += FLOAT_SIZE_OBJECT;
1688 res = make_float(hp);
1689 PUT_DOUBLE(f1, hp);
1690 return res;
1691 default:
1692 goto badarith;
1693 }
1694 default:
1695 goto badarith;
1696 }
1697 }
1698 default:
1699 goto badarith;
1700 }
1701 }
1702
1703 Eterm
erts_gc_mixed_div(Process * p,Eterm * reg,Uint live)1704 erts_gc_mixed_div(Process* p, Eterm* reg, Uint live)
1705 {
1706 Eterm arg1;
1707 Eterm arg2;
1708 FloatDef f1, f2;
1709 Eterm* hp;
1710 Eterm hdr;
1711
1712 arg1 = reg[live];
1713 arg2 = reg[live+1];
1714 ERTS_FP_CHECK_INIT(p);
1715 switch (arg1 & _TAG_PRIMARY_MASK) {
1716 case TAG_PRIMARY_IMMED1:
1717 switch ((arg1 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
1718 case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
1719 switch (arg2 & _TAG_PRIMARY_MASK) {
1720 case TAG_PRIMARY_IMMED1:
1721 switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
1722 case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
1723 f1.fd = signed_val(arg1);
1724 f2.fd = signed_val(arg2);
1725 goto do_float;
1726 default:
1727 badarith:
1728 p->freason = BADARITH;
1729 return THE_NON_VALUE;
1730 }
1731 case TAG_PRIMARY_BOXED:
1732 hdr = *boxed_val(arg2);
1733 switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
1734 case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
1735 case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
1736 f1.fd = signed_val(arg1);
1737 if (big_to_double(arg2, &f2.fd) < 0) {
1738 goto badarith;
1739 }
1740 goto do_float;
1741 case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
1742 f1.fd = signed_val(arg1);
1743 GET_DOUBLE(arg2, f2);
1744 goto do_float;
1745 default:
1746 goto badarith;
1747 }
1748 }
1749 default:
1750 goto badarith;
1751 }
1752 case TAG_PRIMARY_BOXED:
1753 hdr = *boxed_val(arg1);
1754 switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
1755 case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
1756 case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
1757 switch (arg2 & _TAG_PRIMARY_MASK) {
1758 case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
1759 switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
1760 case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
1761 if (big_to_double(arg1, &f1.fd) < 0) {
1762 goto badarith;
1763 }
1764 f2.fd = signed_val(arg2);
1765 goto do_float;
1766 default:
1767 goto badarith;
1768 }
1769 case TAG_PRIMARY_BOXED:
1770 hdr = *boxed_val(arg2);
1771 switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
1772 case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
1773 case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
1774 if (big_to_double(arg1, &f1.fd) < 0 ||
1775 big_to_double(arg2, &f2.fd) < 0) {
1776 goto badarith;
1777 }
1778 goto do_float;
1779 case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
1780 if (big_to_double(arg1, &f1.fd) < 0) {
1781 goto badarith;
1782 }
1783 GET_DOUBLE(arg2, f2);
1784 goto do_float;
1785 default:
1786 goto badarith;
1787 }
1788 }
1789 case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
1790 switch (arg2 & _TAG_PRIMARY_MASK) {
1791 case TAG_PRIMARY_IMMED1:
1792 switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
1793 case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
1794 GET_DOUBLE(arg1, f1);
1795 f2.fd = signed_val(arg2);
1796 goto do_float;
1797 default:
1798 goto badarith;
1799 }
1800 case TAG_PRIMARY_BOXED:
1801 hdr = *boxed_val(arg2);
1802 switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
1803 case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
1804 case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
1805 GET_DOUBLE(arg1, f1);
1806 if (big_to_double(arg2, &f2.fd) < 0) {
1807 goto badarith;
1808 }
1809 goto do_float;
1810 case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
1811 GET_DOUBLE(arg1, f1);
1812 GET_DOUBLE(arg2, f2);
1813
1814 do_float:
1815 f1.fd = f1.fd / f2.fd;
1816 ERTS_FP_ERROR(p, f1.fd, goto badarith);
1817 if (ERTS_NEED_GC(p, FLOAT_SIZE_OBJECT)) {
1818 erts_garbage_collect(p, FLOAT_SIZE_OBJECT, reg, live);
1819 }
1820 hp = p->htop;
1821 p->htop += FLOAT_SIZE_OBJECT;
1822 PUT_DOUBLE(f1, hp);
1823 return make_float(hp);
1824 default:
1825 goto badarith;
1826 }
1827 default:
1828 goto badarith;
1829 }
1830 }
1831 default:
1832 goto badarith;
1833 }
1834 }
1835
1836 Eterm
erts_gc_int_div(Process * p,Eterm * reg,Uint live)1837 erts_gc_int_div(Process* p, Eterm* reg, Uint live)
1838 {
1839 Eterm arg1;
1840 Eterm arg2;
1841 DECLARE_TMP(tmp_big1,0,p);
1842 DECLARE_TMP(tmp_big2,1,p);
1843 int ires;
1844
1845 arg1 = reg[live];
1846 arg2 = reg[live+1];
1847 switch (NUMBER_CODE(arg1, arg2)) {
1848 case SMALL_SMALL:
1849 /* This case occurs if the most negative fixnum is divided by -1. */
1850 ASSERT(arg2 == make_small(-1));
1851 arg1 = small_to_big(signed_val(arg1), tmp_big1);
1852 /*FALLTHROUGH*/
1853 case BIG_SMALL:
1854 arg2 = small_to_big(signed_val(arg2), tmp_big2);
1855 goto L_big_div;
1856 case SMALL_BIG:
1857 if (arg1 != make_small(MIN_SMALL)) {
1858 return SMALL_ZERO;
1859 }
1860 arg1 = small_to_big(signed_val(arg1), tmp_big1);
1861 /*FALLTHROUGH*/
1862 case BIG_BIG:
1863 L_big_div:
1864 ires = big_ucomp(arg1, arg2);
1865 if (ires < 0) {
1866 arg1 = SMALL_ZERO;
1867 } else if (ires == 0) {
1868 arg1 = (big_sign(arg1) == big_sign(arg2)) ?
1869 SMALL_ONE : SMALL_MINUS_ONE;
1870 } else {
1871 Eterm* hp;
1872 int i = big_size(arg1);
1873 Uint need;
1874
1875 ires = big_size(arg2);
1876 need = BIG_NEED_SIZE(i-ires+1) + BIG_NEED_SIZE(i);
1877 if (ERTS_NEED_GC(p, need)) {
1878 erts_garbage_collect(p, need, reg, live+2);
1879 if (ARG_IS_NOT_TMP(arg1,tmp_big1)) {
1880 arg1 = reg[live];
1881 }
1882 if (ARG_IS_NOT_TMP(arg2,tmp_big2)) {
1883 arg2 = reg[live+1];
1884 }
1885 }
1886 hp = p->htop;
1887 p->htop += need;
1888 arg1 = big_div(arg1, arg2, hp);
1889 trim_heap(p, hp, arg1);
1890 if (is_nil(arg1)) {
1891 p->freason = SYSTEM_LIMIT;
1892 return THE_NON_VALUE;
1893 }
1894 }
1895 return arg1;
1896 default:
1897 p->freason = BADARITH;
1898 return THE_NON_VALUE;
1899 }
1900 }
1901
1902 Eterm
erts_gc_int_rem(Process * p,Eterm * reg,Uint live)1903 erts_gc_int_rem(Process* p, Eterm* reg, Uint live)
1904 {
1905 Eterm arg1;
1906 Eterm arg2;
1907 DECLARE_TMP(tmp_big1,0,p);
1908 DECLARE_TMP(tmp_big2,1,p);
1909 int ires;
1910
1911 arg1 = reg[live];
1912 arg2 = reg[live+1];
1913 switch (NUMBER_CODE(arg1, arg2)) {
1914 case BIG_SMALL:
1915 arg2 = small_to_big(signed_val(arg2), tmp_big2);
1916 goto L_big_rem;
1917 case SMALL_BIG:
1918 if (arg1 != make_small(MIN_SMALL)) {
1919 return arg1;
1920 } else {
1921 Eterm tmp;
1922 tmp = small_to_big(signed_val(arg1), tmp_big1);
1923 if ((ires = big_ucomp(tmp, arg2)) == 0) {
1924 return SMALL_ZERO;
1925 } else {
1926 ASSERT(ires < 0);
1927 return arg1;
1928 }
1929 }
1930 /* All paths returned */
1931 case BIG_BIG:
1932 L_big_rem:
1933 ires = big_ucomp(arg1, arg2);
1934 if (ires == 0) {
1935 arg1 = SMALL_ZERO;
1936 } else if (ires > 0) {
1937 Eterm* hp;
1938 Uint need = BIG_NEED_SIZE(big_size(arg1));
1939
1940 if (ERTS_NEED_GC(p, need)) {
1941 erts_garbage_collect(p, need, reg, live+2);
1942 if (ARG_IS_NOT_TMP(arg1,tmp_big1)) {
1943 arg1 = reg[live];
1944 }
1945 if (ARG_IS_NOT_TMP(arg2,tmp_big2)) {
1946 arg2 = reg[live+1];
1947 }
1948 }
1949 hp = p->htop;
1950 p->htop += need;
1951 arg1 = big_rem(arg1, arg2, hp);
1952 trim_heap(p, hp, arg1);
1953 if (is_nil(arg1)) {
1954 p->freason = SYSTEM_LIMIT;
1955 return THE_NON_VALUE;
1956 }
1957 }
1958 return arg1;
1959 default:
1960 p->freason = BADARITH;
1961 return THE_NON_VALUE;
1962 }
1963 }
1964
1965 #define DEFINE_GC_LOGIC_FUNC(func) \
1966 Eterm erts_gc_##func(Process* p, Eterm* reg, Uint live) \
1967 { \
1968 Eterm arg1; \
1969 Eterm arg2; \
1970 DECLARE_TMP(tmp_big1,0,p); \
1971 DECLARE_TMP(tmp_big2,1,p); \
1972 Eterm* hp; \
1973 int need; \
1974 \
1975 arg1 = reg[live]; \
1976 arg2 = reg[live+1]; \
1977 switch (NUMBER_CODE(arg1, arg2)) { \
1978 case SMALL_BIG: \
1979 arg1 = small_to_big(signed_val(arg1), tmp_big1); \
1980 need = BIG_NEED_SIZE(big_size(arg2) + 1); \
1981 if (ERTS_NEED_GC(p, need)) { \
1982 erts_garbage_collect(p, need, reg, live+2); \
1983 arg2 = reg[live+1]; \
1984 } \
1985 break; \
1986 case BIG_SMALL: \
1987 arg2 = small_to_big(signed_val(arg2), tmp_big2); \
1988 need = BIG_NEED_SIZE(big_size(arg1) + 1); \
1989 if (ERTS_NEED_GC(p, need)) { \
1990 erts_garbage_collect(p, need, reg, live+2); \
1991 arg1 = reg[live]; \
1992 } \
1993 break; \
1994 case BIG_BIG: \
1995 need = BIG_NEED_SIZE(MAX(big_size(arg1), big_size(arg2)) + 1); \
1996 if (ERTS_NEED_GC(p, need)) { \
1997 erts_garbage_collect(p, need, reg, live+2); \
1998 arg1 = reg[live]; \
1999 arg2 = reg[live+1]; \
2000 } \
2001 break; \
2002 default: \
2003 p->freason = BADARITH; \
2004 return THE_NON_VALUE; \
2005 } \
2006 hp = p->htop; \
2007 p->htop += need; \
2008 arg1 = big_##func(arg1, arg2, hp); \
2009 trim_heap(p, hp, arg1); \
2010 return arg1; \
2011 }
2012
2013 DEFINE_GC_LOGIC_FUNC(band)
DEFINE_GC_LOGIC_FUNC(bor)2014 DEFINE_GC_LOGIC_FUNC(bor)
2015 DEFINE_GC_LOGIC_FUNC(bxor)
2016
2017 Eterm erts_gc_bnot(Process* p, Eterm* reg, Uint live)
2018 {
2019 Eterm result;
2020 Eterm arg;
2021 Uint need;
2022 Eterm* bigp;
2023
2024 arg = reg[live];
2025 if (is_not_big(arg)) {
2026 p->freason = BADARITH;
2027 return NIL;
2028 } else {
2029 need = BIG_NEED_SIZE(big_size(arg)+1);
2030 if (ERTS_NEED_GC(p, need)) {
2031 erts_garbage_collect(p, need, reg, live+1);
2032 arg = reg[live];
2033 }
2034 bigp = p->htop;
2035 p->htop += need;
2036 result = big_bnot(arg, bigp);
2037 trim_heap(p, bigp, result);
2038 if (is_nil(result)) {
2039 p->freason = SYSTEM_LIMIT;
2040 return NIL;
2041 }
2042 }
2043 return result;
2044 }
2045
2046 /* Needed to remove compiler optimization */
erts_get_positive_zero_float()2047 double erts_get_positive_zero_float() {
2048 return 0.0f;
2049 }
2050