1 /*
2 * %CopyrightBegin%
3 *
4 * Copyright Ericsson AB 2006-2017. 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 * Numeric guard BIFs.
23 */
24
25 #ifdef HAVE_CONFIG_H
26 # include "config.h"
27 #endif
28
29 #include "sys.h"
30 #include "erl_vm.h"
31 #include "global.h"
32 #include "erl_process.h"
33 #include "error.h"
34 #include "bif.h"
35 #include "big.h"
36 #include "erl_binary.h"
37 #include "erl_map.h"
38
39 static Eterm gc_double_to_integer(Process* p, double x, Eterm* reg, Uint live);
40
41 static Eterm double_to_integer(Process* p, double x);
42
43 /*
44 * Guard BIFs called using apply/3 and guard BIFs that never build
45 * anything on the heap.
46 */
47
abs_1(BIF_ALIST_1)48 BIF_RETTYPE abs_1(BIF_ALIST_1)
49 {
50 Eterm res;
51 Sint i0, i;
52 Eterm* hp;
53
54 /* integer arguments */
55 if (is_small(BIF_ARG_1)) {
56 i0 = signed_val(BIF_ARG_1);
57 i = ERTS_SMALL_ABS(i0);
58 if (i0 == MIN_SMALL) {
59 hp = HAlloc(BIF_P, BIG_UINT_HEAP_SIZE);
60 BIF_RET(uint_to_big(i, hp));
61 } else {
62 BIF_RET(make_small(i));
63 }
64 } else if (is_big(BIF_ARG_1)) {
65 if (!big_sign(BIF_ARG_1)) {
66 BIF_RET(BIF_ARG_1);
67 } else {
68 int sz = big_arity(BIF_ARG_1) + 1;
69 Uint* x;
70
71 hp = HAlloc(BIF_P, sz); /* See note at beginning of file */
72 sz--;
73 res = make_big(hp);
74 x = big_val(BIF_ARG_1);
75 *hp++ = make_pos_bignum_header(sz);
76 x++; /* skip thing */
77 while(sz--)
78 *hp++ = *x++;
79 BIF_RET(res);
80 }
81 } else if (is_float(BIF_ARG_1)) {
82 FloatDef f;
83
84 GET_DOUBLE(BIF_ARG_1, f);
85 if (f.fd < 0.0) {
86 hp = HAlloc(BIF_P, FLOAT_SIZE_OBJECT);
87 f.fd = fabs(f.fd);
88 res = make_float(hp);
89 PUT_DOUBLE(f, hp);
90 BIF_RET(res);
91 }
92 else
93 BIF_RET(BIF_ARG_1);
94 }
95 BIF_ERROR(BIF_P, BADARG);
96 }
97
float_1(BIF_ALIST_1)98 BIF_RETTYPE float_1(BIF_ALIST_1)
99 {
100 Eterm res;
101 Eterm* hp;
102 FloatDef f;
103
104 /* check args */
105 if (is_not_integer(BIF_ARG_1)) {
106 if (is_float(BIF_ARG_1)) {
107 BIF_RET(BIF_ARG_1);
108 } else {
109 badarg:
110 BIF_ERROR(BIF_P, BADARG);
111 }
112 }
113 if (is_small(BIF_ARG_1)) {
114 Sint i = signed_val(BIF_ARG_1);
115 f.fd = i; /* use "C"'s auto casting */
116 } else if (big_to_double(BIF_ARG_1, &f.fd) < 0) {
117 goto badarg;
118 }
119 hp = HAlloc(BIF_P, FLOAT_SIZE_OBJECT);
120 res = make_float(hp);
121 PUT_DOUBLE(f, hp);
122 BIF_RET(res);
123 }
124
trunc_1(BIF_ALIST_1)125 BIF_RETTYPE trunc_1(BIF_ALIST_1)
126 {
127 Eterm res;
128 FloatDef f;
129
130 /* check arg */
131 if (is_not_float(BIF_ARG_1)) {
132 if (is_integer(BIF_ARG_1))
133 BIF_RET(BIF_ARG_1);
134 BIF_ERROR(BIF_P, BADARG);
135 }
136 /* get the float */
137 GET_DOUBLE(BIF_ARG_1, f);
138
139 /* truncate it and return the resultant integer */
140 res = double_to_integer(BIF_P, (f.fd >= 0.0) ? floor(f.fd) : ceil(f.fd));
141 BIF_RET(res);
142 }
143
floor_1(BIF_ALIST_1)144 BIF_RETTYPE floor_1(BIF_ALIST_1)
145 {
146 Eterm res;
147 FloatDef f;
148
149 if (is_not_float(BIF_ARG_1)) {
150 if (is_integer(BIF_ARG_1))
151 BIF_RET(BIF_ARG_1);
152 BIF_ERROR(BIF_P, BADARG);
153 }
154 GET_DOUBLE(BIF_ARG_1, f);
155 res = double_to_integer(BIF_P, floor(f.fd));
156 BIF_RET(res);
157 }
158
ceil_1(BIF_ALIST_1)159 BIF_RETTYPE ceil_1(BIF_ALIST_1)
160 {
161 Eterm res;
162 FloatDef f;
163
164 /* check arg */
165 if (is_not_float(BIF_ARG_1)) {
166 if (is_integer(BIF_ARG_1))
167 BIF_RET(BIF_ARG_1);
168 BIF_ERROR(BIF_P, BADARG);
169 }
170 /* get the float */
171 GET_DOUBLE(BIF_ARG_1, f);
172
173 res = double_to_integer(BIF_P, ceil(f.fd));
174 BIF_RET(res);
175 }
176
round_1(BIF_ALIST_1)177 BIF_RETTYPE round_1(BIF_ALIST_1)
178 {
179 Eterm res;
180 FloatDef f;
181
182 /* check arg */
183 if (is_not_float(BIF_ARG_1)) {
184 if (is_integer(BIF_ARG_1))
185 BIF_RET(BIF_ARG_1);
186 BIF_ERROR(BIF_P, BADARG);
187 }
188
189 /* get the float */
190 GET_DOUBLE(BIF_ARG_1, f);
191
192 /* round it and return the resultant integer */
193 res = double_to_integer(BIF_P, round(f.fd));
194 BIF_RET(res);
195 }
196
length_1(BIF_ALIST_1)197 BIF_RETTYPE length_1(BIF_ALIST_1)
198 {
199 Eterm list;
200 Uint i;
201
202 if (is_nil(BIF_ARG_1))
203 BIF_RET(SMALL_ZERO);
204 if (is_not_list(BIF_ARG_1)) {
205 BIF_ERROR(BIF_P, BADARG);
206 }
207 list = BIF_ARG_1;
208 i = 0;
209 while (is_list(list)) {
210 i++;
211 list = CDR(list_val(list));
212 }
213 if (is_not_nil(list)) {
214 BIF_ERROR(BIF_P, BADARG);
215 }
216 BIF_RET(make_small(i));
217 }
218
219 /* returns the size of a tuple or a binary */
220
size_1(BIF_ALIST_1)221 BIF_RETTYPE size_1(BIF_ALIST_1)
222 {
223 if (is_tuple(BIF_ARG_1)) {
224 Eterm* tupleptr = tuple_val(BIF_ARG_1);
225
226 BIF_RET(make_small(arityval(*tupleptr)));
227 } else if (is_binary(BIF_ARG_1)) {
228 Uint sz = binary_size(BIF_ARG_1);
229 if (IS_USMALL(0, sz)) {
230 return make_small(sz);
231 } else {
232 Eterm* hp = HAlloc(BIF_P, BIG_UINT_HEAP_SIZE);
233 BIF_RET(uint_to_big(sz, hp));
234 }
235 }
236 BIF_ERROR(BIF_P, BADARG);
237 }
238
239 /**********************************************************************/
240 /* returns the bitsize of a bitstring */
241
bit_size_1(BIF_ALIST_1)242 BIF_RETTYPE bit_size_1(BIF_ALIST_1)
243 {
244 Uint low_bits;
245 Uint bytesize;
246 Uint high_bits;
247 if (is_binary(BIF_ARG_1)) {
248 bytesize = binary_size(BIF_ARG_1);
249 high_bits = bytesize >> ((sizeof(Uint) * 8)-3);
250 low_bits = (bytesize << 3) + binary_bitsize(BIF_ARG_1);
251 if (high_bits == 0) {
252 if (IS_USMALL(0,low_bits)) {
253 BIF_RET(make_small(low_bits));
254 } else {
255 Eterm* hp = HAlloc(BIF_P, BIG_UINT_HEAP_SIZE);
256 BIF_RET(uint_to_big(low_bits, hp));
257 }
258 } else {
259 Uint sz = BIG_UINT_HEAP_SIZE+1;
260 Eterm* hp = HAlloc(BIF_P, sz);
261 hp[0] = make_pos_bignum_header(sz-1);
262 BIG_DIGIT(hp,0) = low_bits;
263 BIG_DIGIT(hp,1) = high_bits;
264 BIF_RET(make_big(hp));
265 }
266 } else {
267 BIF_ERROR(BIF_P, BADARG);
268 }
269 }
270
271 /**********************************************************************/
272 /* returns the number of bytes need to store a bitstring */
273
byte_size_1(BIF_ALIST_1)274 BIF_RETTYPE byte_size_1(BIF_ALIST_1)
275 {
276 if (is_binary(BIF_ARG_1)) {
277 Uint bytesize = binary_size(BIF_ARG_1);
278 if (binary_bitsize(BIF_ARG_1) > 0) {
279 bytesize++;
280 }
281 if (IS_USMALL(0, bytesize)) {
282 BIF_RET(make_small(bytesize));
283 } else {
284 Eterm* hp = HAlloc(BIF_P, BIG_UINT_HEAP_SIZE);
285 BIF_RET(uint_to_big(bytesize, hp));
286 }
287 } else {
288 BIF_ERROR(BIF_P, BADARG);
289 }
290 }
291
292 /*
293 * Generate the integer part from a double.
294 */
295 static Eterm
double_to_integer(Process * p,double x)296 double_to_integer(Process* p, double x)
297 {
298 int is_negative;
299 int ds;
300 ErtsDigit* xp;
301 int i;
302 Eterm res;
303 size_t sz;
304 Eterm* hp;
305 double dbase;
306
307 if ((x < (double) (MAX_SMALL+1)) && (x > (double) (MIN_SMALL-1))) {
308 Sint xi = x;
309 return make_small(xi);
310 }
311
312 if (x >= 0) {
313 is_negative = 0;
314 } else {
315 is_negative = 1;
316 x = -x;
317 }
318
319 /* Unscale & (calculate exponent) */
320 ds = 0;
321 dbase = ((double)(D_MASK)+1);
322 while(x >= 1.0) {
323 x /= dbase; /* "shift" right */
324 ds++;
325 }
326 sz = BIG_NEED_SIZE(ds); /* number of words including arity */
327
328 hp = HAlloc(p, sz);
329 res = make_big(hp);
330 xp = (ErtsDigit*) (hp + 1);
331
332 for (i = ds-1; i >= 0; i--) {
333 ErtsDigit d;
334
335 x *= dbase; /* "shift" left */
336 d = x; /* trunc */
337 xp[i] = d; /* store digit */
338 x -= d; /* remove integer part */
339 }
340 while ((ds & (BIG_DIGITS_PER_WORD-1)) != 0) {
341 xp[ds++] = 0;
342 }
343
344 if (is_negative) {
345 *hp = make_neg_bignum_header(sz-1);
346 } else {
347 *hp = make_pos_bignum_header(sz-1);
348 }
349 return res;
350 }
351
352 /********************************************************************************
353 * binary_part guards. The actual implementation is in erl_bif_binary.c
354 ********************************************************************************/
binary_part_3(BIF_ALIST_3)355 BIF_RETTYPE binary_part_3(BIF_ALIST_3)
356 {
357 return erts_binary_part(BIF_P,BIF_ARG_1,BIF_ARG_2, BIF_ARG_3);
358 }
359
binary_part_2(BIF_ALIST_2)360 BIF_RETTYPE binary_part_2(BIF_ALIST_2)
361 {
362 Eterm *tp;
363 if (is_not_tuple(BIF_ARG_2)) {
364 goto badarg;
365 }
366 tp = tuple_val(BIF_ARG_2);
367 if (arityval(*tp) != 2) {
368 goto badarg;
369 }
370 return erts_binary_part(BIF_P,BIF_ARG_1,tp[1], tp[2]);
371 badarg:
372 BIF_ERROR(BIF_P,BADARG);
373 }
374
375
376 /*
377 * The following code is used when a guard that may build on the
378 * heap is called directly. They must not use HAlloc(), but must
379 * do a garbage collection if there is insufficient heap space.
380 *
381 * Important note: All error checking MUST be done before doing
382 * a garbage collection. The compiler assumes that all registers
383 * are still valid if a guard BIF generates an exception.
384 */
385
386 #define ERTS_NEED_GC(p, need) ((HEAP_LIMIT((p)) - HEAP_TOP((p))) <= (need))
387
erts_gc_length_1(Process * p,Eterm * reg,Uint live)388 Eterm erts_gc_length_1(Process* p, Eterm* reg, Uint live)
389 {
390 Eterm list = reg[live];
391 int i;
392
393 if (is_nil(list))
394 return SMALL_ZERO;
395 i = 0;
396 while (is_list(list)) {
397 i++;
398 list = CDR(list_val(list));
399 }
400 if (is_not_nil(list)) {
401 BIF_ERROR(p, BADARG);
402 }
403 return make_small(i);
404 }
405
erts_gc_size_1(Process * p,Eterm * reg,Uint live)406 Eterm erts_gc_size_1(Process* p, Eterm* reg, Uint live)
407 {
408 Eterm arg = reg[live];
409 if (is_tuple(arg)) {
410 Eterm* tupleptr = tuple_val(arg);
411 return make_small(arityval(*tupleptr));
412 } else if (is_binary(arg)) {
413 Uint sz = binary_size(arg);
414 if (IS_USMALL(0, sz)) {
415 return make_small(sz);
416 } else {
417 Eterm* hp;
418 if (ERTS_NEED_GC(p, BIG_UINT_HEAP_SIZE)) {
419 erts_garbage_collect(p, BIG_UINT_HEAP_SIZE, reg, live);
420 }
421 hp = p->htop;
422 p->htop += BIG_UINT_HEAP_SIZE;
423 return uint_to_big(sz, hp);
424 }
425 }
426 BIF_ERROR(p, BADARG);
427 }
428
erts_gc_bit_size_1(Process * p,Eterm * reg,Uint live)429 Eterm erts_gc_bit_size_1(Process* p, Eterm* reg, Uint live)
430 {
431 Eterm arg = reg[live];
432 if (is_binary(arg)) {
433 Uint low_bits;
434 Uint bytesize;
435 Uint high_bits;
436 bytesize = binary_size(arg);
437 high_bits = bytesize >> ((sizeof(Uint) * 8)-3);
438 low_bits = (bytesize << 3) + binary_bitsize(arg);
439 if (high_bits == 0) {
440 if (IS_USMALL(0,low_bits)) {
441 return make_small(low_bits);
442 } else {
443 Eterm* hp;
444 if (ERTS_NEED_GC(p, BIG_UINT_HEAP_SIZE)) {
445 erts_garbage_collect(p, BIG_UINT_HEAP_SIZE, reg, live);
446 }
447 hp = p->htop;
448 p->htop += BIG_UINT_HEAP_SIZE;
449 return uint_to_big(low_bits, hp);
450 }
451 } else {
452 Uint sz = BIG_UINT_HEAP_SIZE+1;
453 Eterm* hp;
454 if (ERTS_NEED_GC(p, sz)) {
455 erts_garbage_collect(p, sz, reg, live);
456 }
457 hp = p->htop;
458 p->htop += sz;
459 hp[0] = make_pos_bignum_header(sz-1);
460 BIG_DIGIT(hp,0) = low_bits;
461 BIG_DIGIT(hp,1) = high_bits;
462 return make_big(hp);
463 }
464 } else {
465 BIF_ERROR(p, BADARG);
466 }
467 }
468
erts_gc_byte_size_1(Process * p,Eterm * reg,Uint live)469 Eterm erts_gc_byte_size_1(Process* p, Eterm* reg, Uint live)
470 {
471 Eterm arg = reg[live];
472 if (is_binary(arg)) {
473 Uint bytesize = binary_size(arg);
474 if (binary_bitsize(arg) > 0) {
475 bytesize++;
476 }
477 if (IS_USMALL(0, bytesize)) {
478 return make_small(bytesize);
479 } else {
480 Eterm* hp;
481 if (ERTS_NEED_GC(p, BIG_UINT_HEAP_SIZE)) {
482 erts_garbage_collect(p, BIG_UINT_HEAP_SIZE, reg, live);
483 }
484 hp = p->htop;
485 p->htop += BIG_UINT_HEAP_SIZE;
486 return uint_to_big(bytesize, hp);
487 }
488 } else {
489 BIF_ERROR(p, BADARG);
490 }
491 }
492
erts_gc_map_size_1(Process * p,Eterm * reg,Uint live)493 Eterm erts_gc_map_size_1(Process* p, Eterm* reg, Uint live)
494 {
495 Eterm arg = reg[live];
496 if (is_flatmap(arg)) {
497 flatmap_t *mp = (flatmap_t*)flatmap_val(arg);
498 return make_small(flatmap_get_size(mp));
499 } else if (is_hashmap(arg)) {
500 Eterm* hp;
501 Uint size;
502 size = hashmap_size(arg);
503 if (IS_USMALL(0, size)) {
504 return make_small(size);
505 }
506 if (ERTS_NEED_GC(p, BIG_UINT_HEAP_SIZE)) {
507 erts_garbage_collect(p, BIG_UINT_HEAP_SIZE, reg, live);
508 }
509 hp = p->htop;
510 p->htop += BIG_UINT_HEAP_SIZE;
511 return uint_to_big(size, hp);
512 }
513 p->fvalue = arg;
514 BIF_ERROR(p, BADMAP);
515 }
516
erts_gc_abs_1(Process * p,Eterm * reg,Uint live)517 Eterm erts_gc_abs_1(Process* p, Eterm* reg, Uint live)
518 {
519 Eterm arg;
520 Eterm res;
521 Sint i0, i;
522 Eterm* hp;
523
524 arg = reg[live];
525
526 /* integer arguments */
527 if (is_small(arg)) {
528 i0 = signed_val(arg);
529 i = ERTS_SMALL_ABS(i0);
530 if (i0 == MIN_SMALL) {
531 if (ERTS_NEED_GC(p, BIG_UINT_HEAP_SIZE)) {
532 erts_garbage_collect(p, BIG_UINT_HEAP_SIZE, reg, live+1);
533 arg = reg[live];
534 }
535 hp = p->htop;
536 p->htop += BIG_UINT_HEAP_SIZE;
537 return uint_to_big(i, hp);
538 } else {
539 return make_small(i);
540 }
541 } else if (is_big(arg)) {
542 if (!big_sign(arg)) {
543 return arg;
544 } else {
545 int sz = big_arity(arg) + 1;
546 Uint* x;
547
548 if (ERTS_NEED_GC(p, sz)) {
549 erts_garbage_collect(p, sz, reg, live+1);
550 arg = reg[live];
551 }
552 hp = p->htop;
553 p->htop += sz;
554 sz--;
555 res = make_big(hp);
556 x = big_val(arg);
557 *hp++ = make_pos_bignum_header(sz);
558 x++; /* skip thing */
559 while(sz--)
560 *hp++ = *x++;
561 return res;
562 }
563 } else if (is_float(arg)) {
564 FloatDef f;
565
566 GET_DOUBLE(arg, f);
567 if (f.fd < 0.0) {
568 if (ERTS_NEED_GC(p, FLOAT_SIZE_OBJECT)) {
569 erts_garbage_collect(p, FLOAT_SIZE_OBJECT, reg, live+1);
570 arg = reg[live];
571 }
572 hp = p->htop;
573 p->htop += FLOAT_SIZE_OBJECT;
574 f.fd = fabs(f.fd);
575 res = make_float(hp);
576 PUT_DOUBLE(f, hp);
577 return res;
578 }
579 else
580 return arg;
581 }
582 BIF_ERROR(p, BADARG);
583 }
584
erts_gc_float_1(Process * p,Eterm * reg,Uint live)585 Eterm erts_gc_float_1(Process* p, Eterm* reg, Uint live)
586 {
587 Eterm arg;
588 Eterm res;
589 Eterm* hp;
590 FloatDef f;
591
592 /* check args */
593 arg = reg[live];
594 if (is_not_integer(arg)) {
595 if (is_float(arg)) {
596 return arg;
597 } else {
598 badarg:
599 BIF_ERROR(p, BADARG);
600 }
601 }
602 if (is_small(arg)) {
603 Sint i = signed_val(arg);
604 f.fd = i; /* use "C"'s auto casting */
605 } else if (big_to_double(arg, &f.fd) < 0) {
606 goto badarg;
607 }
608 if (ERTS_NEED_GC(p, FLOAT_SIZE_OBJECT)) {
609 erts_garbage_collect(p, FLOAT_SIZE_OBJECT, reg, live+1);
610 arg = reg[live];
611 }
612 hp = p->htop;
613 p->htop += FLOAT_SIZE_OBJECT;
614 res = make_float(hp);
615 PUT_DOUBLE(f, hp);
616 return res;
617 }
618
erts_gc_round_1(Process * p,Eterm * reg,Uint live)619 Eterm erts_gc_round_1(Process* p, Eterm* reg, Uint live)
620 {
621 Eterm arg;
622 FloatDef f;
623
624 arg = reg[live];
625 if (is_not_float(arg)) {
626 if (is_integer(arg)) {
627 return arg;
628 }
629 BIF_ERROR(p, BADARG);
630 }
631 GET_DOUBLE(arg, f);
632
633 return gc_double_to_integer(p, round(f.fd), reg, live);
634 }
635
erts_gc_trunc_1(Process * p,Eterm * reg,Uint live)636 Eterm erts_gc_trunc_1(Process* p, Eterm* reg, Uint live)
637 {
638 Eterm arg;
639 FloatDef f;
640
641 arg = reg[live];
642 if (is_not_float(arg)) {
643 if (is_integer(arg)) {
644 return arg;
645 }
646 BIF_ERROR(p, BADARG);
647 }
648 /* get the float */
649 GET_DOUBLE(arg, f);
650
651 /* truncate it and return the resultant integer */
652 return gc_double_to_integer(p, (f.fd >= 0.0) ? floor(f.fd) : ceil(f.fd),
653 reg, live);
654 }
655
erts_gc_floor_1(Process * p,Eterm * reg,Uint live)656 Eterm erts_gc_floor_1(Process* p, Eterm* reg, Uint live)
657 {
658 Eterm arg;
659 FloatDef f;
660
661 arg = reg[live];
662 if (is_not_float(arg)) {
663 if (is_integer(arg)) {
664 return arg;
665 }
666 BIF_ERROR(p, BADARG);
667 }
668 GET_DOUBLE(arg, f);
669 return gc_double_to_integer(p, floor(f.fd), reg, live);
670 }
671
erts_gc_ceil_1(Process * p,Eterm * reg,Uint live)672 Eterm erts_gc_ceil_1(Process* p, Eterm* reg, Uint live)
673 {
674 Eterm arg;
675 FloatDef f;
676
677 arg = reg[live];
678 if (is_not_float(arg)) {
679 if (is_integer(arg)) {
680 return arg;
681 }
682 BIF_ERROR(p, BADARG);
683 }
684 GET_DOUBLE(arg, f);
685 return gc_double_to_integer(p, ceil(f.fd), reg, live);
686 }
687
688 static Eterm
gc_double_to_integer(Process * p,double x,Eterm * reg,Uint live)689 gc_double_to_integer(Process* p, double x, Eterm* reg, Uint live)
690 {
691 int is_negative;
692 int ds;
693 ErtsDigit* xp;
694 int i;
695 Eterm res;
696 size_t sz;
697 Eterm* hp;
698 double dbase;
699
700 if ((x < (double) (MAX_SMALL+1)) && (x > (double) (MIN_SMALL-1))) {
701 Sint xi = x;
702 return make_small(xi);
703 }
704
705 if (x >= 0) {
706 is_negative = 0;
707 } else {
708 is_negative = 1;
709 x = -x;
710 }
711
712 /* Unscale & (calculate exponent) */
713 ds = 0;
714 dbase = ((double)(D_MASK)+1);
715 while(x >= 1.0) {
716 x /= dbase; /* "shift" right */
717 ds++;
718 }
719 sz = BIG_NEED_SIZE(ds); /* number of words including arity */
720 if (ERTS_NEED_GC(p, sz)) {
721 erts_garbage_collect(p, sz, reg, live);
722 }
723 hp = p->htop;
724 p->htop += sz;
725 res = make_big(hp);
726 xp = (ErtsDigit*) (hp + 1);
727
728 for (i = ds-1; i >= 0; i--) {
729 ErtsDigit d;
730
731 x *= dbase; /* "shift" left */
732 d = x; /* trunc */
733 xp[i] = d; /* store digit */
734 x -= d; /* remove integer part */
735 }
736 while ((ds & (BIG_DIGITS_PER_WORD-1)) != 0) {
737 xp[ds++] = 0;
738 }
739
740 if (is_negative) {
741 *hp = make_neg_bignum_header(sz-1);
742 } else {
743 *hp = make_pos_bignum_header(sz-1);
744 }
745 return res;
746 }
747
748 /********************************************************************************
749 * binary_part guards. The actual implementation is in erl_bif_binary.c
750 ********************************************************************************/
erts_gc_binary_part_3(Process * p,Eterm * reg,Uint live)751 Eterm erts_gc_binary_part_3(Process* p, Eterm* reg, Uint live)
752 {
753 return erts_gc_binary_part(p,reg,live,0);
754 }
755
erts_gc_binary_part_2(Process * p,Eterm * reg,Uint live)756 Eterm erts_gc_binary_part_2(Process* p, Eterm* reg, Uint live)
757 {
758 return erts_gc_binary_part(p,reg,live,1);
759 }
760