aboutsummaryrefslogtreecommitdiffstats
path: root/erts/emulator/beam
diff options
context:
space:
mode:
authorBjörn Gustavsson <[email protected]>2018-12-03 10:23:15 +0100
committerBjörn Gustavsson <[email protected]>2018-12-13 10:31:22 +0100
commit3691c6ab52ace5a3f0c1ddf51b7ab6e0b9abb385 (patch)
tree52a10fc4ec361d4dca69186d9bfc1d30d5d52b47 /erts/emulator/beam
parentf19a52e92ae56b8e5248064db56dc38c0d7dff69 (diff)
downloadotp-3691c6ab52ace5a3f0c1ddf51b7ab6e0b9abb385.tar.gz
otp-3691c6ab52ace5a3f0c1ddf51b7ab6e0b9abb385.tar.bz2
otp-3691c6ab52ace5a3f0c1ddf51b7ab6e0b9abb385.zip
Simplify GC BIFs
Summary: This commit simplifies the implementation of the "GC BIFs" so that they no longer need to do a garbage collection, removing duplicate code for all GC BIFs in the runtime system, as well as potentially reducing the size of the loaded BEAM code by using shorter instructions calling those BIFs. A GC BIF is a guard BIF that will do a garbage collection if it needs to build anything on the heap. For example, `abs/1` is a GC BIF because it might need to allocate space on the heap (if the result is a floating point number or the resulting integer is a bignum). Before R12, a guard BIF (such as `abs/1`) that need to allocate heap space would allocate outside of process's main heap, in a heap fragment. GC BIFs were introduced in R12B to support literals. During garbage collection it become necessary to quickly test whether a term was a literal. To make the check simple, guards BIFs were no longer allowed to create heap fragments. Instead GC BIFs were introduced. In OTP 19, the implementation of literals was changed to support storing messages in heap fragments outside of the main heap for a process. That change again made it allowed for guard BIFs to create heap fragments when they need to build terms on the heap. It would even be possible for the guard BIFs to build directly on the main heap if there is room there, because the compiler assumes that a new `test_heap/2` instruction must be emitted when building anything after calling a GC BIF. (We don't do that in this commit; see below.) This commit simplifies the implementation of the GC BIFs in the runtime system. Each GC BIF had a dual implementation: one that was used when the GC BIF was called directly and one used when it was called via `apply/3`. For example, `abs/1` was implemented in `abs_1()` and `erts_gc_abs_1()`. This commit removes the GC version of each BIF. The other version that allocates heap space using `HAlloc()` is updated to use the new `HeapFragOnlyAlloc()` macro that will allocate heap space in a heap fragment outside of the main heap. Because the BIFs will allocate outside of the main heap, the same `bif` instructions used by nonbuilding BIFs can be used for the (former) GC BIFs. Those instructions don't use the macros that save and restore the heap and stack pointers (SWAPOUT/SWAPIN). If the former GC BIFs would build on the main heap, either new instructions would be needed, or SWAPOUT/SWAPIN instructions would need to be added to the `bif` instructions. Instructions that call the former GC BIFs don't need the operand that specifies the number of live X registers. Therefore, the instructions that call the BIFs are usually one word shorter.
Diffstat (limited to 'erts/emulator/beam')
-rw-r--r--erts/emulator/beam/arith_instrs.tab105
-rw-r--r--erts/emulator/beam/beam_debug.c17
-rw-r--r--erts/emulator/beam/beam_emu.c19
-rw-r--r--erts/emulator/beam/beam_load.c114
-rw-r--r--erts/emulator/beam/bif.tab26
-rw-r--r--erts/emulator/beam/bif_instrs.tab175
-rw-r--r--erts/emulator/beam/erl_arith.c970
-rw-r--r--erts/emulator/beam/erl_bif_binary.c98
-rw-r--r--erts/emulator/beam/erl_bif_guard.c418
-rw-r--r--erts/emulator/beam/erl_binary.h1
-rw-r--r--erts/emulator/beam/erl_map.c17
-rw-r--r--erts/emulator/beam/erl_vm.h15
-rw-r--r--erts/emulator/beam/ops.tab108
13 files changed, 223 insertions, 1860 deletions
diff --git a/erts/emulator/beam/arith_instrs.tab b/erts/emulator/beam/arith_instrs.tab
index b828e86788..574fceec5b 100644
--- a/erts/emulator/beam/arith_instrs.tab
+++ b/erts/emulator/beam/arith_instrs.tab
@@ -19,21 +19,22 @@
// %CopyrightEnd%
//
-OUTLINED_ARITH_2(Fail, Live, Name, BIF, Op1, Op2, Dst) {
+OUTLINED_ARITH_2(Fail, Name, BIF, Op1, Op2, Dst) {
Eterm result;
- Uint live = $Live;
- HEAVY_SWAPOUT;
- reg[live] = $Op1;
- reg[live+1] = $Op2;
- result = erts_gc_$Name (c_p, reg, live);
- HEAVY_SWAPIN;
+#ifdef DEBUG
+ Eterm* orig_htop = HTOP;
+ Eterm* orig_stop = E;
+#endif
+ DEBUG_SWAPOUT;
+ result = erts_$Name (c_p, $Op1, $Op2);
+ DEBUG_SWAPIN;
+ ASSERT(orig_htop == HTOP && orig_stop == E);
ERTS_HOLE_CHECK(c_p);
if (ERTS_LIKELY(is_value(result))) {
- $REFRESH_GEN_DEST();
$Dst = result;
$NEXT0();
}
- $BIF_ERROR_ARITY_2($Fail, $BIF, reg[live], reg[live+1]);
+ $BIF_ERROR_ARITY_2($Fail, $BIF, $Op1, $Op2);
}
@@ -48,7 +49,7 @@ plus.fetch(Op1, Op2) {
PlusOp2 = $Op2;
}
-plus.execute(Fail, Live, Dst) {
+plus.execute(Fail, Dst) {
if (ERTS_LIKELY(is_both_small(PlusOp1, PlusOp2))) {
Sint i = signed_val(PlusOp1) + signed_val(PlusOp2);
if (ERTS_LIKELY(IS_SSMALL(i))) {
@@ -56,7 +57,7 @@ plus.execute(Fail, Live, Dst) {
$NEXT0();
}
}
- $OUTLINED_ARITH_2($Fail, $Live, mixed_plus, BIF_splus_2, PlusOp1, PlusOp2, $Dst);
+ $OUTLINED_ARITH_2($Fail, mixed_plus, BIF_splus_2, PlusOp1, PlusOp2, $Dst);
}
i_minus := minus.fetch.execute;
@@ -70,7 +71,7 @@ minus.fetch(Op1, Op2) {
MinusOp2 = $Op2;
}
-minus.execute(Fail, Live, Dst) {
+minus.execute(Fail, Dst) {
if (ERTS_LIKELY(is_both_small(MinusOp1, MinusOp2))) {
Sint i = signed_val(MinusOp1) - signed_val(MinusOp2);
if (ERTS_LIKELY(IS_SSMALL(i))) {
@@ -78,7 +79,7 @@ minus.execute(Fail, Live, Dst) {
$NEXT0();
}
}
- $OUTLINED_ARITH_2($Fail, $Live, mixed_minus, BIF_sminus_2, MinusOp1, MinusOp2, $Dst);
+ $OUTLINED_ARITH_2($Fail, mixed_minus, BIF_sminus_2, MinusOp1, MinusOp2, $Dst);
}
i_increment := increment.fetch.execute;
@@ -91,9 +92,8 @@ increment.fetch(Src) {
increment_reg_val = $Src;
}
-increment.execute(IncrementVal, Live, Dst) {
+increment.execute(IncrementVal, Dst) {
Eterm increment_val = $IncrementVal;
- Uint live;
Eterm result;
if (ERTS_LIKELY(is_small(increment_reg_val))) {
@@ -103,15 +103,9 @@ increment.execute(IncrementVal, Live, Dst) {
$NEXT0();
}
}
- live = $Live;
- HEAVY_SWAPOUT;
- reg[live] = increment_reg_val;
- reg[live+1] = make_small(increment_val);
- result = erts_gc_mixed_plus(c_p, reg, live);
- HEAVY_SWAPIN;
+ result = erts_mixed_plus(c_p, increment_reg_val, make_small(increment_val));
ERTS_HOLE_CHECK(c_p);
if (ERTS_LIKELY(is_value(result))) {
- $REFRESH_GEN_DEST();
$Dst = result;
$NEXT0();
}
@@ -119,19 +113,19 @@ increment.execute(IncrementVal, Live, Dst) {
goto find_func_info;
}
-i_times(Fail, Live, Op1, Op2, Dst) {
+i_times(Fail, Op1, Op2, Dst) {
Eterm op1 = $Op1;
Eterm op2 = $Op2;
- $OUTLINED_ARITH_2($Fail, $Live, mixed_times, BIF_stimes_2, op1, op2, $Dst);
+ $OUTLINED_ARITH_2($Fail, mixed_times, BIF_stimes_2, op1, op2, $Dst);
}
-i_m_div(Fail, Live, Op1, Op2, Dst) {
+i_m_div(Fail, Op1, Op2, Dst) {
Eterm op1 = $Op1;
Eterm op2 = $Op2;
- $OUTLINED_ARITH_2($Fail, $Live, mixed_div, BIF_div_2, op1, op2, $Dst);
+ $OUTLINED_ARITH_2($Fail, mixed_div, BIF_div_2, op1, op2, $Dst);
}
-i_int_div(Fail, Live, Op1, Op2, Dst) {
+i_int_div(Fail, Op1, Op2, Dst) {
Eterm op1 = $Op1;
Eterm op2 = $Op2;
if (ERTS_UNLIKELY(op2 == SMALL_ZERO)) {
@@ -144,7 +138,7 @@ i_int_div(Fail, Live, Op1, Op2, Dst) {
$NEXT0();
}
}
- $OUTLINED_ARITH_2($Fail, $Live, int_div, BIF_intdiv_2, op1, op2, $Dst);
+ $OUTLINED_ARITH_2($Fail, int_div, BIF_intdiv_2, op1, op2, $Dst);
}
i_rem := rem.fetch.execute;
@@ -158,7 +152,7 @@ rem.fetch(Src1, Src2) {
RemOp2 = $Src2;
}
-rem.execute(Fail, Live, Dst) {
+rem.execute(Fail, Dst) {
if (ERTS_UNLIKELY(RemOp2 == SMALL_ZERO)) {
c_p->freason = BADARITH;
$BIF_ERROR_ARITY_2($Fail, BIF_rem_2, RemOp1, RemOp2);
@@ -166,7 +160,7 @@ rem.execute(Fail, Live, Dst) {
$Dst = make_small(signed_val(RemOp1) % signed_val(RemOp2));
$NEXT0();
} else {
- $OUTLINED_ARITH_2($Fail, $Live, int_rem, BIF_rem_2, RemOp1, RemOp2, $Dst);
+ $OUTLINED_ARITH_2($Fail, int_rem, BIF_rem_2, RemOp1, RemOp2, $Dst);
}
}
@@ -181,7 +175,7 @@ band.fetch(Src1, Src2) {
BandOp2 = $Src2;
}
-band.execute(Fail, Live, Dst) {
+band.execute(Fail, Dst) {
if (ERTS_LIKELY(is_both_small(BandOp1, BandOp2))) {
/*
* No need to untag -- TAG & TAG == TAG.
@@ -189,10 +183,10 @@ band.execute(Fail, Live, Dst) {
$Dst = BandOp1 & BandOp2;
$NEXT0();
}
- $OUTLINED_ARITH_2($Fail, $Live, band, BIF_band_2, BandOp1, BandOp2, $Dst);
+ $OUTLINED_ARITH_2($Fail, band, BIF_band_2, BandOp1, BandOp2, $Dst);
}
-i_bor(Fail, Live, Src1, Src2, Dst) {
+i_bor(Fail, Src1, Src2, Dst) {
if (ERTS_LIKELY(is_both_small($Src1, $Src2))) {
/*
* No need to untag -- TAG | TAG == TAG.
@@ -200,10 +194,10 @@ i_bor(Fail, Live, Src1, Src2, Dst) {
$Dst = $Src1 | $Src2;
$NEXT0();
}
- $OUTLINED_ARITH_2($Fail, $Live, bor, BIF_bor_2, $Src1, $Src2, $Dst);
+ $OUTLINED_ARITH_2($Fail, bor, BIF_bor_2, $Src1, $Src2, $Dst);
}
-i_bxor(Fail, Live, Src1, Src2, Dst) {
+i_bxor(Fail, Src1, Src2, Dst) {
if (ERTS_LIKELY(is_both_small($Src1, $Src2))) {
/*
* TAG ^ TAG == 0.
@@ -214,7 +208,7 @@ i_bxor(Fail, Live, Src1, Src2, Dst) {
$Dst = ($Src1 ^ $Src2) | make_small(0);
$NEXT0();
}
- $OUTLINED_ARITH_2($Fail, $Live, bxor, BIF_bxor_2, $Src1, $Src2, $Dst);
+ $OUTLINED_ARITH_2($Fail, bxor, BIF_bxor_2, $Src1, $Src2, $Dst);
}
i_bsl := shift.setup_bsl.execute;
@@ -265,7 +259,7 @@ shift.setup_bsl(Src1, Src2) {
}
}
-shift.execute(Fail, Live, Dst) {
+shift.execute(Fail, Dst) {
Uint big_words_needed;
if (ERTS_LIKELY(is_small(Op1))) {
@@ -320,7 +314,9 @@ shift.execute(Fail, Live, Dst) {
}
{
Eterm tmp_big[2];
- Sint big_need_size = BIG_NEED_SIZE(big_words_needed+1);
+ Sint big_need_size = 1 + BIG_NEED_SIZE(big_words_needed+1);
+ Eterm* hp;
+ Eterm* hp_end;
/*
* Slightly conservative check the size to avoid
@@ -331,15 +327,16 @@ shift.execute(Fail, Live, Dst) {
if (big_need_size-8 > BIG_ARITY_MAX) {
$SYSTEM_LIMIT($Fail);
}
- $GC_TEST_PRESERVE(big_need_size+1, $Live, Op1);
+ hp = HeapFragOnlyAlloc(c_p, big_need_size);
if (is_small(Op1)) {
Op1 = small_to_big(signed_val(Op1), tmp_big);
}
- Op1 = big_lshift(Op1, shift_left_count, HTOP);
+ Op1 = big_lshift(Op1, shift_left_count, hp);
+ hp_end = hp + big_need_size;
if (is_big(Op1)) {
- HTOP += bignum_header_arity(*HTOP) + 1;
+ hp += bignum_header_arity(*hp) + 1;
}
- HEAP_SPACE_VERIFIED(0);
+ HRelease(c_p, hp_end, hp);
if (ERTS_UNLIKELY(is_nil(Op1))) {
/*
* This result must have been only slighty larger
@@ -349,7 +346,6 @@ shift.execute(Fail, Live, Dst) {
$SYSTEM_LIMIT($Fail);
}
ERTS_HOLE_CHECK(c_p);
- $REFRESH_GEN_DEST();
$Dst = Op1;
$NEXT0();
}
@@ -366,31 +362,28 @@ shift.execute(Fail, Live, Dst) {
reg[0] = Op1;
reg[1] = Op2;
SWAPOUT;
- if (IsOpCode(I[0], i_bsl_ssjtd)) {
+ if (IsOpCode(I[0], i_bsl_ssjd)) {
I = handle_error(c_p, I, reg, &bif_export[BIF_bsl_2]->info.mfa);
} else {
- ASSERT(IsOpCode(I[0], i_bsr_ssjtd));
+ ASSERT(IsOpCode(I[0], i_bsr_ssjd));
I = handle_error(c_p, I, reg, &bif_export[BIF_bsr_2]->info.mfa);
}
goto post_error_handling;
}
}
-i_int_bnot(Fail, Src, Live, Dst) {
+i_int_bnot(Fail, Src, Dst) {
Eterm bnot_val = $Src;
+ Eterm result;
+
if (ERTS_LIKELY(is_small(bnot_val))) {
- bnot_val = make_small(~signed_val(bnot_val));
+ result = make_small(~signed_val(bnot_val));
} else {
- Uint live = $Live;
- HEAVY_SWAPOUT;
- reg[live] = bnot_val;
- bnot_val = erts_gc_bnot(c_p, reg, live);
- HEAVY_SWAPIN;
+ result = erts_bnot(c_p, bnot_val);
ERTS_HOLE_CHECK(c_p);
- if (ERTS_UNLIKELY(is_nil(bnot_val))) {
- $BIF_ERROR_ARITY_1($Fail, BIF_bnot_1, reg[live]);
+ if (ERTS_UNLIKELY(is_nil(result))) {
+ $BIF_ERROR_ARITY_1($Fail, BIF_bnot_1, bnot_val);
}
- $REFRESH_GEN_DEST();
}
- $Dst = bnot_val;
+ $Dst = result;
}
diff --git a/erts/emulator/beam/beam_debug.c b/erts/emulator/beam/beam_debug.c
index b33aab7eee..f71efd708f 100644
--- a/erts/emulator/beam/beam_debug.c
+++ b/erts/emulator/beam/beam_debug.c
@@ -558,23 +558,6 @@ print_op(fmtfn_t to, void *to_arg, int op, int size, BeamInstr* addr)
case 'I':
case 'W':
switch (op) {
- case op_i_gc_bif1_jWstd:
- case op_i_gc_bif2_jWtssd:
- case op_i_gc_bif3_jWtssd:
- {
- const ErtsGcBif* p;
- BifFunction gcf = (BifFunction) *ap;
- for (p = erts_gc_bifs; p->bif != 0; p++) {
- if (p->gc_bif == gcf) {
- print_bif_name(to, to_arg, p->bif);
- break;
- }
- }
- if (p->bif == 0) {
- erts_print(to, to_arg, "%d", (Uint)gcf);
- }
- break;
- }
case op_i_make_fun_Wt:
if (*sign == 'W') {
ErlFunEntry* fe = (ErlFunEntry *) *ap;
diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c
index 2e4d1f8f48..6b34024a5a 100644
--- a/erts/emulator/beam/beam_emu.c
+++ b/erts/emulator/beam/beam_emu.c
@@ -206,8 +206,12 @@ void** beam_ops;
#ifdef DEBUG
# /* The stack pointer is used in an assertion. */
# define LIGHT_SWAPOUT SWAPOUT
+# define DEBUG_SWAPOUT SWAPOUT
+# define DEBUG_SWAPIN SWAPIN
#else
# define LIGHT_SWAPOUT HEAP_TOP(c_p) = HTOP
+# define DEBUG_SWAPOUT
+# define DEBUG_SWAPIN
#endif
/*
@@ -386,7 +390,6 @@ do { \
*/
static void init_emulator_finish(void) NOINLINE;
static ErtsCodeMFA *ubif2mfa(void* uf) NOINLINE;
-static ErtsCodeMFA *gcbif2mfa(void* gcf) NOINLINE;
static BeamInstr* handle_error(Process* c_p, BeamInstr* pc,
Eterm* reg, ErtsCodeMFA* bif_mfa) NOINLINE;
static BeamInstr* call_error_handler(Process* p, ErtsCodeMFA* mfa,
@@ -1301,18 +1304,6 @@ void erts_dirty_process_main(ErtsSchedulerData *esdp)
}
static ErtsCodeMFA *
-gcbif2mfa(void* gcf)
-{
- int i;
- for (i = 0; erts_gc_bifs[i].bif; i++) {
- if (erts_gc_bifs[i].gc_bif == gcf)
- return &bif_export[erts_gc_bifs[i].exp_ix]->info.mfa;
- }
- erts_exit(ERTS_ERROR_EXIT, "bad gc bif");
- return NULL;
-}
-
-static ErtsCodeMFA *
ubif2mfa(void* uf)
{
int i;
@@ -1320,7 +1311,7 @@ ubif2mfa(void* uf)
if (erts_u_bifs[i].bif == uf)
return &bif_export[erts_u_bifs[i].exp_ix]->info.mfa;
}
- erts_exit(ERTS_ERROR_EXIT, "bad u bif");
+ erts_exit(ERTS_ERROR_EXIT, "bad u bif: %p\n", uf);
return NULL;
}
diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c
index c28a5c57e6..400a58a75c 100644
--- a/erts/emulator/beam/beam_load.c
+++ b/erts/emulator/beam/beam_load.c
@@ -3580,38 +3580,36 @@ gen_skip_bits2(LoaderState* stp, GenOpArg Fail, GenOpArg Ms,
}
static GenOp*
-gen_increment(LoaderState* stp, GenOpArg Reg, GenOpArg Integer,
- GenOpArg Live, GenOpArg Dst)
+gen_increment(LoaderState* stp, GenOpArg Reg,
+ GenOpArg Integer, GenOpArg Dst)
{
GenOp* op;
NEW_GENOP(stp, op);
- op->op = genop_i_increment_4;
- op->arity = 4;
+ op->op = genop_i_increment_3;
+ op->arity = 3;
op->next = NULL;
op->a[0] = Reg;
op->a[1].type = TAG_u;
op->a[1].val = Integer.val;
- op->a[2] = Live;
- op->a[3] = Dst;
+ op->a[2] = Dst;
return op;
}
static GenOp*
-gen_increment_from_minus(LoaderState* stp, GenOpArg Reg, GenOpArg Integer,
- GenOpArg Live, GenOpArg Dst)
+gen_increment_from_minus(LoaderState* stp, GenOpArg Reg,
+ GenOpArg Integer, GenOpArg Dst)
{
GenOp* op;
NEW_GENOP(stp, op);
- op->op = genop_i_increment_4;
- op->arity = 4;
+ op->op = genop_i_increment_3;
+ op->arity = 3;
op->next = NULL;
op->a[0] = Reg;
op->a[1].type = TAG_u;
op->a[1].val = -Integer.val;
- op->a[2] = Live;
- op->a[3] = Dst;
+ op->a[2] = Dst;
return op;
}
@@ -4300,98 +4298,6 @@ gen_make_fun2(LoaderState* stp, GenOpArg idx)
}
static GenOp*
-translate_gc_bif(LoaderState* stp, GenOp* op, GenOpArg Bif)
-{
- const ErtsGcBif* p;
- BifFunction bf;
-
- bf = stp->import[Bif.val].bf;
- for (p = erts_gc_bifs; p->bif != 0; p++) {
- if (p->bif == bf) {
- op->a[1].type = TAG_u;
- op->a[1].val = (BeamInstr) p->gc_bif;
- return op;
- }
- }
-
- op->op = genop_unsupported_guard_bif_3;
- op->arity = 3;
- op->a[0].type = TAG_a;
- op->a[0].val = stp->import[Bif.val].module;
- op->a[1].type = TAG_a;
- op->a[1].val = stp->import[Bif.val].function;
- op->a[2].type = TAG_u;
- op->a[2].val = stp->import[Bif.val].arity;
- return op;
-}
-
-/*
- * Rewrite gc_bifs with one parameter (the common case).
- */
-static GenOp*
-gen_guard_bif1(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif,
- GenOpArg Src, GenOpArg Dst)
-{
- GenOp* op;
-
- NEW_GENOP(stp, op);
- op->next = NULL;
- op->op = genop_i_gc_bif1_5;
- op->arity = 5;
- op->a[0] = Fail;
- /* op->a[1] is set by translate_gc_bif() */
- op->a[2] = Src;
- op->a[3] = Live;
- op->a[4] = Dst;
- return translate_gc_bif(stp, op, Bif);
-}
-
-/*
- * This is used by the ops.tab rule that rewrites gc_bifs with two parameters.
- */
-static GenOp*
-gen_guard_bif2(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif,
- GenOpArg S1, GenOpArg S2, GenOpArg Dst)
-{
- GenOp* op;
-
- NEW_GENOP(stp, op);
- op->next = NULL;
- op->op = genop_i_gc_bif2_6;
- op->arity = 6;
- op->a[0] = Fail;
- /* op->a[1] is set by translate_gc_bif() */
- op->a[2] = Live;
- op->a[3] = S1;
- op->a[4] = S2;
- op->a[5] = Dst;
- return translate_gc_bif(stp, op, Bif);
-}
-
-/*
- * This is used by the ops.tab rule that rewrites gc_bifs with three parameters.
- */
-static GenOp*
-gen_guard_bif3(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif,
- GenOpArg S1, GenOpArg S2, GenOpArg S3, GenOpArg Dst)
-{
- GenOp* op;
-
- NEW_GENOP(stp, op);
- op->next = NULL;
- op->op = genop_ii_gc_bif3_7;
- op->arity = 7;
- op->a[0] = Fail;
- /* op->a[1] is set by translate_gc_bif() */
- op->a[2] = Live;
- op->a[3] = S1;
- op->a[4] = S2;
- op->a[5] = S3;
- op->a[6] = Dst;
- return translate_gc_bif(stp, op, Bif);
-}
-
-static GenOp*
tuple_append_put5(LoaderState* stp, GenOpArg Arity, GenOpArg Dst,
GenOpArg* Puts, GenOpArg S1, GenOpArg S2, GenOpArg S3,
GenOpArg S4, GenOpArg S5)
diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab
index 35e10f3e63..f141407c0e 100644
--- a/erts/emulator/beam/bif.tab
+++ b/erts/emulator/beam/bif.tab
@@ -41,7 +41,7 @@
#
-gcbif erlang:abs/1
+ubif erlang:abs/1
bif erlang:adler32/1
bif erlang:adler32/2
bif erlang:adler32_combine/3
@@ -66,7 +66,7 @@ bif erlang:exit/2
bif erlang:exit_signal/2
bif erlang:external_size/1
bif erlang:external_size/2
-gcbif erlang:float/1
+ubif erlang:float/1
bif erlang:float_to_list/1
bif erlang:float_to_list/2
bif erlang:fun_info/2
@@ -84,7 +84,7 @@ bif erlang:phash2/2
ubif erlang:hd/1
bif erlang:integer_to_list/1
bif erlang:is_alive/0
-gcbif erlang:length/1
+ubif erlang:length/1
bif erlang:link/1
bif erlang:list_to_atom/1
bif erlang:list_to_binary/1
@@ -133,10 +133,10 @@ bif erlang:processes/0
bif erlang:put/2
bif erlang:register/2
bif erlang:registered/0
-gcbif erlang:round/1
+ubif erlang:round/1
ubif erlang:self/0
bif erlang:setelement/3
-gcbif erlang:size/1
+ubif erlang:size/1
bif erlang:spawn/3
bif erlang:spawn_link/3
bif erlang:split_binary/2
@@ -146,7 +146,7 @@ bif erlang:term_to_binary/2
bif erlang:throw/1
bif erlang:time/0
ubif erlang:tl/1
-gcbif erlang:trunc/1
+ubif erlang:trunc/1
bif erlang:tuple_to_list/1
bif erlang:universaltime/0
bif erlang:universaltime_to_localtime/1
@@ -481,8 +481,8 @@ bif erlang:list_to_existing_atom/1
#
ubif erlang:is_bitstring/1
ubif erlang:tuple_size/1
-gcbif erlang:byte_size/1
-gcbif erlang:bit_size/1
+ubif erlang:byte_size/1
+ubif erlang:bit_size/1
bif erlang:list_to_bitstring/1
bif erlang:bitstring_to_list/1
@@ -534,8 +534,8 @@ bif erlang:binary_to_term/2
#
# The searching/splitting/substituting thingies
#
-gcbif erlang:binary_part/2
-gcbif erlang:binary_part/3
+ubif erlang:binary_part/2
+ubif erlang:binary_part/3
bif binary:compile_pattern/1
bif binary:match/2
@@ -623,7 +623,7 @@ bif io:printable_range/0
bif re:inspect/2
ubif erlang:is_map/1
-gcbif erlang:map_size/1
+ubif erlang:map_size/1
bif maps:find/2
bif maps:get/2
bif maps:from_list/1
@@ -671,8 +671,8 @@ bif maps:take/2
# New in 20.0
#
-gcbif erlang:floor/1
-gcbif erlang:ceil/1
+ubif erlang:floor/1
+ubif erlang:ceil/1
bif math:floor/1
bif math:ceil/1
bif math:fmod/2
diff --git a/erts/emulator/beam/bif_instrs.tab b/erts/emulator/beam/bif_instrs.tab
index 00854471a9..3abd062552 100644
--- a/erts/emulator/beam/bif_instrs.tab
+++ b/erts/emulator/beam/bif_instrs.tab
@@ -31,13 +31,20 @@
CALL_GUARD_BIF(BF, TmpReg, Dst) {
Eterm result;
+#ifdef DEBUG
+ Eterm* orig_htop = HTOP;
+ Eterm* orig_stop = E;
+#endif
ERTS_DBG_CHK_REDS(c_p, FCALLS);
c_p->fcalls = FCALLS;
PROCESS_MAIN_CHK_LOCKS(c_p);
ASSERT(!ERTS_PROC_IS_EXITING(c_p));
ERTS_CHK_MBUF_SZ(c_p);
+ DEBUG_SWAPOUT;
result = (*$BF)(c_p, $TmpReg, I);
+ DEBUG_SWAPIN;
+ ASSERT(orig_htop == HTOP && orig_stop == E);
ERTS_CHK_MBUF_SZ(c_p);
ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result));
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
@@ -55,7 +62,7 @@ CALL_GUARD_BIF(BF, TmpReg, Dst) {
// to the code for the next clause. We don't support tracing
// of guard BIFs.
-bif1(Fail, Bif, Src, Dst) {
+i_bif1(Fail, Bif, Src, Dst) {
ErtsBifFunc bf;
Eterm tmp_reg[1];
@@ -70,7 +77,7 @@ bif1(Fail, Bif, Src, Dst) {
// Guard BIF in body. It can fail like any BIF. No trace support.
//
-bif1_body(Bif, Src, Dst) {
+i_bif1_body(Bif, Src, Dst) {
ErtsBifFunc bf;
Eterm tmp_reg[1];
@@ -118,154 +125,38 @@ i_bif2_body(Bif, Src1, Src2, Dst) {
goto post_error_handling;
}
-//
-// Garbage-collecting BIF with one argument in either guard or body.
-//
-
-i_gc_bif1(Fail, Bif, Src, Live, Dst) {
- typedef Eterm (*GcBifFunction)(Process*, Eterm*, Uint);
- GcBifFunction bf;
- Eterm result;
- Uint live = (Uint) $Live;
-
- x(live) = $Src;
- bf = (GcBifFunction) $Bif;
- ERTS_DBG_CHK_REDS(c_p, FCALLS);
- c_p->fcalls = FCALLS;
- SWAPOUT;
- PROCESS_MAIN_CHK_LOCKS(c_p);
- ERTS_UNREQ_PROC_MAIN_LOCK(c_p);
- ERTS_CHK_MBUF_SZ(c_p);
- result = (*bf)(c_p, reg, live);
- ERTS_CHK_MBUF_SZ(c_p);
- ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
- ERTS_REQ_PROC_MAIN_LOCK(c_p);
- PROCESS_MAIN_CHK_LOCKS(c_p);
- SWAPIN;
- ERTS_HOLE_CHECK(c_p);
- FCALLS = c_p->fcalls;
- ERTS_DBG_CHK_REDS(c_p, FCALLS);
- if (ERTS_LIKELY(is_value(result))) {
- $REFRESH_GEN_DEST();
- $Dst = result;
- $NEXT0();
- }
- if (ERTS_LIKELY($Fail != 0)) { /* Handle error in guard. */
- $JUMP($Fail);
- }
-
- /* Handle error in body. */
- x(0) = x(live);
- I = handle_error(c_p, I, reg, gcbif2mfa((void *) bf));
- goto post_error_handling;
-}
-
-//
-// Garbage-collecting BIF with two arguments in either guard or body.
-//
-
-i_gc_bif2(Fail, Bif, Live, Src1, Src2, Dst) {
- typedef Eterm (*GcBifFunction)(Process*, Eterm*, Uint);
- GcBifFunction bf;
- Eterm result;
- Uint live = (Uint) $Live;
-
- /*
- * XXX This calling convention does not make sense. 'live'
- * should point out the first argument, not the second
- * (i.e. 'live' should not be incremented below).
- */
- x(live) = $Src1;
- x(live+1) = $Src2;
- live++;
+// Guard BIF in head (binary_part/3). On failure, ignore the error
+// and jump to the code for the next clause. We don't support tracing
+// of guard BIFs.
- bf = (GcBifFunction) $Bif;
- ERTS_DBG_CHK_REDS(c_p, FCALLS);
- c_p->fcalls = FCALLS;
- SWAPOUT;
- PROCESS_MAIN_CHK_LOCKS(c_p);
- ERTS_UNREQ_PROC_MAIN_LOCK(c_p);
- ERTS_CHK_MBUF_SZ(c_p);
- result = (*bf)(c_p, reg, live);
- ERTS_CHK_MBUF_SZ(c_p);
- ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
- ERTS_REQ_PROC_MAIN_LOCK(c_p);
- PROCESS_MAIN_CHK_LOCKS(c_p);
- SWAPIN;
- ERTS_HOLE_CHECK(c_p);
- FCALLS = c_p->fcalls;
- ERTS_DBG_CHK_REDS(c_p, FCALLS);
- if (ERTS_LIKELY(is_value(result))) {
- $REFRESH_GEN_DEST();
- $Dst = result;
- $NEXT0();
- }
+i_bif3(Fail, Bif, Src1, Src2, Src3, Dst) {
+ ErtsBifFunc bf;
+ Eterm tmp_reg[3];
- if (ERTS_LIKELY($Fail != 0)) { /* Handle error in guard. */
- $JUMP($Fail);
- }
+ tmp_reg[0] = $Src1;
+ tmp_reg[1] = $Src2;
+ tmp_reg[2] = $Src3;
+ bf = (BifFunction) $Bif;
+ $CALL_GUARD_BIF(bf, tmp_reg, $Dst);
- /* Handle error in body. */
- live--;
- x(0) = x(live);
- x(1) = x(live+1);
- I = handle_error(c_p, I, reg, gcbif2mfa((void *) bf));
- goto post_error_handling;
+ $FAIL($Fail);
}
-//
-// Garbage-collecting BIF with three arguments in either guard or body.
-//
-
-i_gc_bif3(Fail, Bif, Live, Src2, Src3, Dst) {
- typedef Eterm (*GcBifFunction)(Process*, Eterm*, Uint);
- GcBifFunction bf;
- Eterm result;
- Uint live = (Uint) $Live;
+// Guard BIF in body with three arguments (binary_part/3).
- /*
- * XXX This calling convention does not make sense. 'live'
- * should point out the first argument, not the third
- * (i.e. 'live' should not be incremented below).
- */
- x(live) = x(SCRATCH_X_REG);
- x(live+1) = $Src2;
- x(live+2) = $Src3;
- live += 2;
+i_bif3_body(Bif, Src1, Src2, Src3, Dst) {
+ ErtsBifFunc bf;
+ Eterm tmp_reg[3];
- bf = (GcBifFunction) $Bif;
- ERTS_DBG_CHK_REDS(c_p, FCALLS);
- c_p->fcalls = FCALLS;
+ tmp_reg[0] = $Src1;
+ tmp_reg[1] = $Src2;
+ tmp_reg[2] = $Src3;
+ bf = (BifFunction) $Bif;
+ $CALL_GUARD_BIF(bf, tmp_reg, $Dst);
+ reg[0] = tmp_reg[0];
+ reg[1] = tmp_reg[1];
SWAPOUT;
- PROCESS_MAIN_CHK_LOCKS(c_p);
- ERTS_UNREQ_PROC_MAIN_LOCK(c_p);
- ERTS_CHK_MBUF_SZ(c_p);
- result = (*bf)(c_p, reg, live);
- ERTS_CHK_MBUF_SZ(c_p);
- ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
- ERTS_REQ_PROC_MAIN_LOCK(c_p);
- PROCESS_MAIN_CHK_LOCKS(c_p);
- SWAPIN;
- ERTS_HOLE_CHECK(c_p);
- FCALLS = c_p->fcalls;
- ERTS_DBG_CHK_REDS(c_p, FCALLS);
- if (ERTS_LIKELY(is_value(result))) {
- $REFRESH_GEN_DEST();
- $Dst = result;
- $NEXT0();
- }
-
- /* Handle error in guard. */
- if (ERTS_LIKELY($Fail != 0)) {
- $JUMP($Fail);
- }
-
- /* Handle error in body. */
- live -= 2;
- x(0) = x(live);
- x(1) = x(live+1);
- x(2) = x(live+2);
- I = handle_error(c_p, I, reg, gcbif2mfa((void *) bf));
+ I = handle_error(c_p, I, reg, ubif2mfa((void *) bf));
goto post_error_handling;
}
diff --git a/erts/emulator/beam/erl_arith.c b/erts/emulator/beam/erl_arith.c
index 144fb56ea5..68d1cd989e 100644
--- a/erts/emulator/beam/erl_arith.c
+++ b/erts/emulator/beam/erl_arith.c
@@ -52,19 +52,11 @@ static ERTS_INLINE void maybe_shrink(Process* p, Eterm* hp, Eterm res, Uint allo
Uint actual;
if (is_immed(res)) {
- if (p->heap <= hp && hp < p->htop) {
- p->htop = hp;
- }
- else {
- erts_heap_frag_shrink(p, hp);
- }
+ ASSERT(!(p->heap <= hp && hp < p->htop));
+ erts_heap_frag_shrink(p, hp);
} else if ((actual = bignum_header_arity(*hp)+1) < alloc) {
- if (p->heap <= hp && hp < p->htop) {
- p->htop = hp+actual;
- }
- else {
- erts_heap_frag_shrink(p, hp+actual);
- }
+ ASSERT(!(p->heap <= hp && hp < p->htop));
+ erts_heap_frag_shrink(p, hp+actual);
}
}
@@ -246,7 +238,7 @@ shift(Process* p, Eterm arg1, Eterm arg2, int right)
BIF_ERROR(p, SYSTEM_LIMIT);
}
need = BIG_NEED_SIZE(ires+1);
- bigp = HAlloc(p, need);
+ bigp = HeapFragOnlyAlloc(p, need);
arg1 = big_lshift(arg1, i, bigp);
maybe_shrink(p, bigp, arg1, need);
if (is_nil(arg1)) {
@@ -298,7 +290,7 @@ BIF_RETTYPE bnot_1(BIF_ALIST_1)
ret = make_small(~signed_val(BIF_ARG_1));
} else if (is_big(BIF_ARG_1)) {
Uint need = BIG_NEED_SIZE(big_size(BIF_ARG_1)+1);
- Eterm* bigp = HAlloc(BIF_P, need);
+ Eterm* bigp = HeapFragOnlyAlloc(BIF_P, need);
ret = big_bnot(BIF_ARG_1, bigp);
maybe_shrink(BIF_P, bigp, ret, need);
@@ -343,7 +335,7 @@ erts_mixed_plus(Process* p, Eterm arg1, Eterm arg2)
if (IS_SSMALL(ires)) {
return make_small(ires);
} else {
- hp = HAlloc(p, 2);
+ hp = HeapFragOnlyAlloc(p, 2);
res = small_to_big(ires, hp);
return res;
}
@@ -400,7 +392,7 @@ erts_mixed_plus(Process* p, Eterm arg1, Eterm arg2)
sz2 = big_size(arg2);
sz = MAX(sz1, sz2)+1;
need_heap = BIG_NEED_SIZE(sz);
- hp = HAlloc(p, need_heap);
+ hp = HeapFragOnlyAlloc(p, need_heap);
res = big_plus(arg1, arg2, hp);
maybe_shrink(p, hp, res, need_heap);
if (is_nil(res)) {
@@ -446,7 +438,7 @@ erts_mixed_plus(Process* p, Eterm arg1, Eterm arg2)
do_float:
f1.fd = f1.fd + f2.fd;
ERTS_FP_ERROR(p, f1.fd, goto badarith);
- hp = HAlloc(p, FLOAT_SIZE_OBJECT);
+ hp = HeapFragOnlyAlloc(p, FLOAT_SIZE_OBJECT);
res = make_float(hp);
PUT_DOUBLE(f1, hp);
return res;
@@ -488,7 +480,7 @@ erts_mixed_minus(Process* p, Eterm arg1, Eterm arg2)
if (IS_SSMALL(ires)) {
return make_small(ires);
} else {
- hp = HAlloc(p, 2);
+ hp = HeapFragOnlyAlloc(p, 2);
res = small_to_big(ires, hp);
return res;
}
@@ -534,7 +526,7 @@ erts_mixed_minus(Process* p, Eterm arg1, Eterm arg2)
sz2 = big_size(arg2);
sz = MAX(sz1, sz2)+1;
need_heap = BIG_NEED_SIZE(sz);
- hp = HAlloc(p, need_heap);
+ hp = HeapFragOnlyAlloc(p, need_heap);
res = big_minus(arg1, arg2, hp);
maybe_shrink(p, hp, res, need_heap);
if (is_nil(res)) {
@@ -589,7 +581,7 @@ erts_mixed_minus(Process* p, Eterm arg1, Eterm arg2)
do_float:
f1.fd = f1.fd - f2.fd;
ERTS_FP_ERROR(p, f1.fd, goto badarith);
- hp = HAlloc(p, FLOAT_SIZE_OBJECT);
+ hp = HeapFragOnlyAlloc(p, FLOAT_SIZE_OBJECT);
res = make_float(hp);
PUT_DOUBLE(f1, hp);
return res;
@@ -657,7 +649,7 @@ erts_mixed_times(Process* p, Eterm arg1, Eterm arg2)
hdr = big_res[0];
arity = bignum_header_arity(hdr);
ASSERT(arity == 1 || arity == 2);
- hp = HAlloc(p, arity+1);
+ hp = HeapFragOnlyAlloc(p, arity+1);
res = make_big(hp);
*hp++ = hdr;
*hp++ = big_res[1];
@@ -726,7 +718,7 @@ erts_mixed_times(Process* p, Eterm arg1, Eterm arg2)
do_big:
need_heap = BIG_NEED_SIZE(sz);
- hp = HAlloc(p, need_heap);
+ hp = HeapFragOnlyAlloc(p, need_heap);
res = big_times(arg1, arg2, hp);
/*
@@ -779,7 +771,7 @@ erts_mixed_times(Process* p, Eterm arg1, Eterm arg2)
do_float:
f1.fd = f1.fd * f2.fd;
ERTS_FP_ERROR(p, f1.fd, goto badarith);
- hp = HAlloc(p, FLOAT_SIZE_OBJECT);
+ hp = HeapFragOnlyAlloc(p, FLOAT_SIZE_OBJECT);
res = make_float(hp);
PUT_DOUBLE(f1, hp);
return res;
@@ -905,7 +897,7 @@ erts_mixed_div(Process* p, Eterm arg1, Eterm arg2)
do_float:
f1.fd = f1.fd / f2.fd;
ERTS_FP_ERROR(p, f1.fd, goto badarith);
- hp = HAlloc(p, FLOAT_SIZE_OBJECT);
+ hp = HeapFragOnlyAlloc(p, FLOAT_SIZE_OBJECT);
PUT_DOUBLE(f1, hp);
return make_float(hp);
default:
@@ -957,7 +949,7 @@ erts_int_div(Process* p, Eterm arg1, Eterm arg2)
ires = big_size(arg2);
need = BIG_NEED_SIZE(i-ires+1) + BIG_NEED_SIZE(i);
- hp = HAlloc(p, need);
+ hp = HeapFragOnlyAlloc(p, need);
arg1 = big_div(arg1, arg2, hp);
maybe_shrink(p, hp, arg1, need);
if (is_nil(arg1)) {
@@ -1004,7 +996,7 @@ erts_int_rem(Process* p, Eterm arg1, Eterm arg2)
arg1 = SMALL_ZERO;
} else if (ires > 0) {
Uint need = BIG_NEED_SIZE(big_size(arg1));
- Eterm* hp = HAlloc(p, need);
+ Eterm* hp = HeapFragOnlyAlloc(p, need);
arg1 = big_rem(arg1, arg2, hp);
maybe_shrink(p, hp, arg1, need);
@@ -1041,7 +1033,7 @@ Eterm erts_band(Process* p, Eterm arg1, Eterm arg2)
return THE_NON_VALUE;
}
need = BIG_NEED_SIZE(MAX(big_size(arg1), big_size(arg2)) + 1);
- hp = HAlloc(p, need);
+ hp = HeapFragOnlyAlloc(p, need);
arg1 = big_band(arg1, arg2, hp);
ASSERT(is_not_nil(arg1));
maybe_shrink(p, hp, arg1, need);
@@ -1069,7 +1061,7 @@ Eterm erts_bor(Process* p, Eterm arg1, Eterm arg2)
return THE_NON_VALUE;
}
need = BIG_NEED_SIZE(MAX(big_size(arg1), big_size(arg2)) + 1);
- hp = HAlloc(p, need);
+ hp = HeapFragOnlyAlloc(p, need);
arg1 = big_bor(arg1, arg2, hp);
ASSERT(is_not_nil(arg1));
maybe_shrink(p, hp, arg1, need);
@@ -1097,7 +1089,7 @@ Eterm erts_bxor(Process* p, Eterm arg1, Eterm arg2)
return THE_NON_VALUE;
}
need = BIG_NEED_SIZE(MAX(big_size(arg1), big_size(arg2)) + 1);
- hp = HAlloc(p, need);
+ hp = HeapFragOnlyAlloc(p, need);
arg1 = big_bxor(arg1, arg2, hp);
ASSERT(is_not_nil(arg1));
maybe_shrink(p, hp, arg1, need);
@@ -1110,7 +1102,7 @@ Eterm erts_bnot(Process* p, Eterm arg)
if (is_big(arg)) {
Uint need = BIG_NEED_SIZE(big_size(arg)+1);
- Eterm* bigp = HAlloc(p, need);
+ Eterm* bigp = HeapFragOnlyAlloc(p, need);
ret = big_bnot(arg, bigp);
maybe_shrink(p, bigp, ret, need);
@@ -1125,924 +1117,6 @@ Eterm erts_bnot(Process* p, Eterm arg)
return ret;
}
-#define ERTS_NEED_GC(p, need) ((HEAP_LIMIT((p)) - HEAP_TOP((p))) <= (need))
-
-static ERTS_INLINE void
-trim_heap(Process* p, Eterm* hp, Eterm res)
-{
- if (is_immed(res)) {
- ASSERT(p->heap <= hp && hp <= p->htop);
- p->htop = hp;
- } else {
- Eterm* new_htop;
- ASSERT(is_big(res));
- new_htop = hp + bignum_header_arity(*hp) + 1;
- ASSERT(p->heap <= new_htop && new_htop <= p->htop);
- p->htop = new_htop;
- }
- ASSERT(p->heap <= p->htop && p->htop <= p->stop);
-}
-
-/*
- * The functions that follow are called from the emulator loop.
- * They are not allowed to allocate heap fragments, but must do
- * a garbage collection if there is insufficient heap space.
- */
-
-#define erts_heap_frag_shrink horrible error
-#define maybe_shrink horrible error
-
-Eterm
-erts_gc_mixed_plus(Process* p, Eterm* reg, Uint live)
-{
- Eterm arg1;
- Eterm arg2;
- DECLARE_TMP(tmp_big1,0,p);
- DECLARE_TMP(tmp_big2,1,p);
- Eterm res;
- Eterm hdr;
- FloatDef f1, f2;
- dsize_t sz1, sz2, sz;
- int need_heap;
- Eterm* hp;
- Sint ires;
-
- arg1 = reg[live];
- arg2 = reg[live+1];
- ERTS_FP_CHECK_INIT(p);
- switch (arg1 & _TAG_PRIMARY_MASK) {
- case TAG_PRIMARY_IMMED1:
- switch ((arg1 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
- case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
- switch (arg2 & _TAG_PRIMARY_MASK) {
- case TAG_PRIMARY_IMMED1:
- switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
- case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
- ires = signed_val(arg1) + signed_val(arg2);
- if (IS_SSMALL(ires)) {
- return make_small(ires);
- } else {
- if (ERTS_NEED_GC(p, 2)) {
- erts_garbage_collect(p, 2, reg, live);
- }
- hp = p->htop;
- p->htop += 2;
- res = small_to_big(ires, hp);
- return res;
- }
- default:
- badarith:
- p->freason = BADARITH;
- return THE_NON_VALUE;
- }
- case TAG_PRIMARY_BOXED:
- hdr = *boxed_val(arg2);
- switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
- case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
- case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
- if (arg1 == SMALL_ZERO) {
- return arg2;
- }
- arg1 = small_to_big(signed_val(arg1), tmp_big1);
- goto do_big;
- case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
- f1.fd = signed_val(arg1);
- GET_DOUBLE(arg2, f2);
- goto do_float;
- default:
- goto badarith;
- }
- }
- default:
- goto badarith;
- }
- case TAG_PRIMARY_BOXED:
- hdr = *boxed_val(arg1);
- switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
- case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
- case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
- switch (arg2 & _TAG_PRIMARY_MASK) {
- case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
- switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
- case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
- if (arg2 == SMALL_ZERO) {
- return arg1;
- }
- arg2 = small_to_big(signed_val(arg2), tmp_big2);
- goto do_big;
- default:
- goto badarith;
- }
- case TAG_PRIMARY_BOXED:
- hdr = *boxed_val(arg2);
- switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
- case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
- case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
- do_big:
- sz1 = big_size(arg1);
- sz2 = big_size(arg2);
- sz = MAX(sz1, sz2)+1;
- need_heap = BIG_NEED_SIZE(sz);
- if (ERTS_NEED_GC(p, need_heap)) {
- erts_garbage_collect(p, need_heap, reg, live+2);
- if (ARG_IS_NOT_TMP(arg1,tmp_big1)) {
- arg1 = reg[live];
- }
- if (ARG_IS_NOT_TMP(arg2,tmp_big2)) {
- arg2 = reg[live+1];
- }
- }
- hp = p->htop;
- p->htop += need_heap;
- res = big_plus(arg1, arg2, hp);
- trim_heap(p, hp, res);
- if (is_nil(res)) {
- p->freason = SYSTEM_LIMIT;
- return THE_NON_VALUE;
- }
- return res;
- case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
- if (big_to_double(arg1, &f1.fd) < 0) {
- goto badarith;
- }
- GET_DOUBLE(arg2, f2);
- goto do_float;
- default:
- goto badarith;
- }
- }
- case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
- switch (arg2 & _TAG_PRIMARY_MASK) {
- case TAG_PRIMARY_IMMED1:
- switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
- case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
- GET_DOUBLE(arg1, f1);
- f2.fd = signed_val(arg2);
- goto do_float;
- default:
- goto badarith;
- }
- case TAG_PRIMARY_BOXED:
- hdr = *boxed_val(arg2);
- switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
- case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
- case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
- GET_DOUBLE(arg1, f1);
- if (big_to_double(arg2, &f2.fd) < 0) {
- goto badarith;
- }
- goto do_float;
- case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
- GET_DOUBLE(arg1, f1);
- GET_DOUBLE(arg2, f2);
-
- do_float:
- f1.fd = f1.fd + f2.fd;
- ERTS_FP_ERROR(p, f1.fd, goto badarith);
- if (ERTS_NEED_GC(p, FLOAT_SIZE_OBJECT)) {
- erts_garbage_collect(p, FLOAT_SIZE_OBJECT, reg, live);
- }
- hp = p->htop;
- p->htop += FLOAT_SIZE_OBJECT;
- res = make_float(hp);
- PUT_DOUBLE(f1, hp);
- return res;
- default:
- goto badarith;
- }
- default:
- goto badarith;
- }
- }
- default:
- goto badarith;
- }
-}
-
-Eterm
-erts_gc_mixed_minus(Process* p, Eterm* reg, Uint live)
-{
- Eterm arg1;
- Eterm arg2;
- DECLARE_TMP(tmp_big1,0,p);
- DECLARE_TMP(tmp_big2,1,p);
- Eterm hdr;
- Eterm res;
- FloatDef f1, f2;
- dsize_t sz1, sz2, sz;
- int need_heap;
- Eterm* hp;
- Sint ires;
-
- arg1 = reg[live];
- arg2 = reg[live+1];
- ERTS_FP_CHECK_INIT(p);
- switch (arg1 & _TAG_PRIMARY_MASK) {
- case TAG_PRIMARY_IMMED1:
- switch ((arg1 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
- case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
- switch (arg2 & _TAG_PRIMARY_MASK) {
- case TAG_PRIMARY_IMMED1:
- switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
- case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
- ires = signed_val(arg1) - signed_val(arg2);
- if (IS_SSMALL(ires)) {
- return make_small(ires);
- } else {
- if (ERTS_NEED_GC(p, 2)) {
- erts_garbage_collect(p, 2, reg, live);
- }
- hp = p->htop;
- p->htop += 2;
- res = small_to_big(ires, hp);
- return res;
- }
- default:
- badarith:
- p->freason = BADARITH;
- return THE_NON_VALUE;
- }
- case TAG_PRIMARY_BOXED:
- hdr = *boxed_val(arg2);
- switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
- case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
- case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
- arg1 = small_to_big(signed_val(arg1), tmp_big1);
- goto do_big;
- case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
- f1.fd = signed_val(arg1);
- GET_DOUBLE(arg2, f2);
- goto do_float;
- default:
- goto badarith;
- }
- }
- default:
- goto badarith;
- }
- case TAG_PRIMARY_BOXED:
- hdr = *boxed_val(arg1);
- switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
- case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
- case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
- switch (arg2 & _TAG_PRIMARY_MASK) {
- case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
- switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
- case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
- if (arg2 == SMALL_ZERO) {
- return arg1;
- }
- arg2 = small_to_big(signed_val(arg2), tmp_big2);
-
- do_big:
- sz1 = big_size(arg1);
- sz2 = big_size(arg2);
- sz = MAX(sz1, sz2)+1;
- need_heap = BIG_NEED_SIZE(sz);
- if (ERTS_NEED_GC(p, need_heap)) {
- erts_garbage_collect(p, need_heap, reg, live+2);
- if (ARG_IS_NOT_TMP(arg1,tmp_big1)) {
- arg1 = reg[live];
- }
- if (ARG_IS_NOT_TMP(arg2,tmp_big2)) {
- arg2 = reg[live+1];
- }
- }
- hp = p->htop;
- p->htop += need_heap;
- res = big_minus(arg1, arg2, hp);
- trim_heap(p, hp, res);
- if (is_nil(res)) {
- p->freason = SYSTEM_LIMIT;
- return THE_NON_VALUE;
- }
- return res;
- default:
- goto badarith;
- }
- case TAG_PRIMARY_BOXED:
- hdr = *boxed_val(arg2);
- switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
- case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
- case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
- goto do_big;
- case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
- if (big_to_double(arg1, &f1.fd) < 0) {
- goto badarith;
- }
- GET_DOUBLE(arg2, f2);
- goto do_float;
- default:
- goto badarith;
- }
- }
- case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
- switch (arg2 & _TAG_PRIMARY_MASK) {
- case TAG_PRIMARY_IMMED1:
- switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
- case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
- GET_DOUBLE(arg1, f1);
- f2.fd = signed_val(arg2);
- goto do_float;
- default:
- goto badarith;
- }
- case TAG_PRIMARY_BOXED:
- hdr = *boxed_val(arg2);
- switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
- case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
- case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
- GET_DOUBLE(arg1, f1);
- if (big_to_double(arg2, &f2.fd) < 0) {
- goto badarith;
- }
- goto do_float;
- case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
- GET_DOUBLE(arg1, f1);
- GET_DOUBLE(arg2, f2);
-
- do_float:
- f1.fd = f1.fd - f2.fd;
- ERTS_FP_ERROR(p, f1.fd, goto badarith);
- if (ERTS_NEED_GC(p, FLOAT_SIZE_OBJECT)) {
- erts_garbage_collect(p, FLOAT_SIZE_OBJECT, reg, live);
- }
- hp = p->htop;
- p->htop += FLOAT_SIZE_OBJECT;
- res = make_float(hp);
- PUT_DOUBLE(f1, hp);
- return res;
- default:
- goto badarith;
- }
- default:
- goto badarith;
- }
- }
- default:
- goto badarith;
- }
-}
-
-Eterm
-erts_gc_mixed_times(Process* p, Eterm* reg, Uint live)
-{
- Eterm arg1;
- Eterm arg2;
- DECLARE_TMP(tmp_big1,0,p);
- DECLARE_TMP(tmp_big2,1,p);
- Eterm hdr;
- Eterm res;
- FloatDef f1, f2;
- dsize_t sz1, sz2, sz;
- int need_heap;
- Eterm* hp;
-
- arg1 = reg[live];
- arg2 = reg[live+1];
- ERTS_FP_CHECK_INIT(p);
- switch (arg1 & _TAG_PRIMARY_MASK) {
- case TAG_PRIMARY_IMMED1:
- switch ((arg1 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
- case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
- switch (arg2 & _TAG_PRIMARY_MASK) {
- case TAG_PRIMARY_IMMED1:
- switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
- case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
- if ((arg1 == SMALL_ZERO) || (arg2 == SMALL_ZERO)) {
- return(SMALL_ZERO);
- } else if (arg1 == SMALL_ONE) {
- return(arg2);
- } else if (arg2 == SMALL_ONE) {
- return(arg1);
- } else {
- DeclareTmpHeap(big_res,3,p);
- UseTmpHeap(3,p);
-
- /*
- * The following code is optimized for the case that
- * result is small (which should be the most common case
- * in practice).
- */
- res = small_times(signed_val(arg1), signed_val(arg2),
- big_res);
- if (is_small(res)) {
- UnUseTmpHeap(3,p);
- return res;
- } else {
- /*
- * The result is a a big number.
- * Allocate a heap fragment and copy the result.
- * Be careful to allocate exactly what we need
- * to not leave any holes.
- */
- Uint arity;
- Uint need;
-
- ASSERT(is_big(res));
- hdr = big_res[0];
- arity = bignum_header_arity(hdr);
- ASSERT(arity == 1 || arity == 2);
- need = arity + 1;
- if (ERTS_NEED_GC(p, need)) {
- erts_garbage_collect(p, need, reg, live);
- }
- hp = p->htop;
- p->htop += need;
- res = make_big(hp);
- *hp++ = hdr;
- *hp++ = big_res[1];
- if (arity > 1) {
- *hp = big_res[2];
- }
- UnUseTmpHeap(3,p);
- return res;
- }
- }
- default:
- badarith:
- p->freason = BADARITH;
- return THE_NON_VALUE;
- }
- case TAG_PRIMARY_BOXED:
- hdr = *boxed_val(arg2);
- switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
- case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
- case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
- if (arg1 == SMALL_ZERO)
- return(SMALL_ZERO);
- if (arg1 == SMALL_ONE)
- return(arg2);
- arg1 = small_to_big(signed_val(arg1), tmp_big1);
- sz = 2 + big_size(arg2);
- goto do_big;
- case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
- f1.fd = signed_val(arg1);
- GET_DOUBLE(arg2, f2);
- goto do_float;
- default:
- goto badarith;
- }
- }
- default:
- goto badarith;
- }
- case TAG_PRIMARY_BOXED:
- hdr = *boxed_val(arg1);
- switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
- case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
- case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
- switch (arg2 & _TAG_PRIMARY_MASK) {
- case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
- switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
- case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
- if (arg2 == SMALL_ZERO)
- return(SMALL_ZERO);
- if (arg2 == SMALL_ONE)
- return(arg1);
- arg2 = small_to_big(signed_val(arg2), tmp_big2);
- sz = 2 + big_size(arg1);
- goto do_big;
- default:
- goto badarith;
- }
- case TAG_PRIMARY_BOXED:
- hdr = *boxed_val(arg2);
- switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
- case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
- case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
- sz1 = big_size(arg1);
- sz2 = big_size(arg2);
- sz = sz1 + sz2;
-
- do_big:
- need_heap = BIG_NEED_SIZE(sz);
- if (ERTS_NEED_GC(p, need_heap)) {
- erts_garbage_collect(p, need_heap, reg, live+2);
- if (ARG_IS_NOT_TMP(arg1,tmp_big1)) {
- arg1 = reg[live];
- }
- if (ARG_IS_NOT_TMP(arg2,tmp_big2)) {
- arg2 = reg[live+1];
- }
- }
- hp = p->htop;
- p->htop += need_heap;
- res = big_times(arg1, arg2, hp);
- trim_heap(p, hp, res);
-
- /*
- * Note that the result must be big in this case, since
- * at least one operand was big to begin with, and
- * the absolute value of the other is > 1.
- */
-
- if (is_nil(res)) {
- p->freason = SYSTEM_LIMIT;
- return THE_NON_VALUE;
- }
- return res;
- case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
- if (big_to_double(arg1, &f1.fd) < 0) {
- goto badarith;
- }
- GET_DOUBLE(arg2, f2);
- goto do_float;
- default:
- goto badarith;
- }
- }
- case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
- switch (arg2 & _TAG_PRIMARY_MASK) {
- case TAG_PRIMARY_IMMED1:
- switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
- case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
- GET_DOUBLE(arg1, f1);
- f2.fd = signed_val(arg2);
- goto do_float;
- default:
- goto badarith;
- }
- case TAG_PRIMARY_BOXED:
- hdr = *boxed_val(arg2);
- switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
- case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
- case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
- GET_DOUBLE(arg1, f1);
- if (big_to_double(arg2, &f2.fd) < 0) {
- goto badarith;
- }
- goto do_float;
- case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
- GET_DOUBLE(arg1, f1);
- GET_DOUBLE(arg2, f2);
-
- do_float:
- f1.fd = f1.fd * f2.fd;
- ERTS_FP_ERROR(p, f1.fd, goto badarith);
- if (ERTS_NEED_GC(p, FLOAT_SIZE_OBJECT)) {
- erts_garbage_collect(p, FLOAT_SIZE_OBJECT, reg, live);
- }
- hp = p->htop;
- p->htop += FLOAT_SIZE_OBJECT;
- res = make_float(hp);
- PUT_DOUBLE(f1, hp);
- return res;
- default:
- goto badarith;
- }
- default:
- goto badarith;
- }
- }
- default:
- goto badarith;
- }
-}
-
-Eterm
-erts_gc_mixed_div(Process* p, Eterm* reg, Uint live)
-{
- Eterm arg1;
- Eterm arg2;
- FloatDef f1, f2;
- Eterm* hp;
- Eterm hdr;
-
- arg1 = reg[live];
- arg2 = reg[live+1];
- ERTS_FP_CHECK_INIT(p);
- switch (arg1 & _TAG_PRIMARY_MASK) {
- case TAG_PRIMARY_IMMED1:
- switch ((arg1 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
- case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
- switch (arg2 & _TAG_PRIMARY_MASK) {
- case TAG_PRIMARY_IMMED1:
- switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
- case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
- f1.fd = signed_val(arg1);
- f2.fd = signed_val(arg2);
- goto do_float;
- default:
- badarith:
- p->freason = BADARITH;
- return THE_NON_VALUE;
- }
- case TAG_PRIMARY_BOXED:
- hdr = *boxed_val(arg2);
- switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
- case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
- case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
- f1.fd = signed_val(arg1);
- if (big_to_double(arg2, &f2.fd) < 0) {
- goto badarith;
- }
- goto do_float;
- case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
- f1.fd = signed_val(arg1);
- GET_DOUBLE(arg2, f2);
- goto do_float;
- default:
- goto badarith;
- }
- }
- default:
- goto badarith;
- }
- case TAG_PRIMARY_BOXED:
- hdr = *boxed_val(arg1);
- switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
- case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
- case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
- switch (arg2 & _TAG_PRIMARY_MASK) {
- case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
- switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
- case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
- if (big_to_double(arg1, &f1.fd) < 0) {
- goto badarith;
- }
- f2.fd = signed_val(arg2);
- goto do_float;
- default:
- goto badarith;
- }
- case TAG_PRIMARY_BOXED:
- hdr = *boxed_val(arg2);
- switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
- case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
- case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
- if (big_to_double(arg1, &f1.fd) < 0 ||
- big_to_double(arg2, &f2.fd) < 0) {
- goto badarith;
- }
- goto do_float;
- case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
- if (big_to_double(arg1, &f1.fd) < 0) {
- goto badarith;
- }
- GET_DOUBLE(arg2, f2);
- goto do_float;
- default:
- goto badarith;
- }
- }
- case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
- switch (arg2 & _TAG_PRIMARY_MASK) {
- case TAG_PRIMARY_IMMED1:
- switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
- case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
- GET_DOUBLE(arg1, f1);
- f2.fd = signed_val(arg2);
- goto do_float;
- default:
- goto badarith;
- }
- case TAG_PRIMARY_BOXED:
- hdr = *boxed_val(arg2);
- switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
- case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
- case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
- GET_DOUBLE(arg1, f1);
- if (big_to_double(arg2, &f2.fd) < 0) {
- goto badarith;
- }
- goto do_float;
- case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
- GET_DOUBLE(arg1, f1);
- GET_DOUBLE(arg2, f2);
-
- do_float:
- f1.fd = f1.fd / f2.fd;
- ERTS_FP_ERROR(p, f1.fd, goto badarith);
- if (ERTS_NEED_GC(p, FLOAT_SIZE_OBJECT)) {
- erts_garbage_collect(p, FLOAT_SIZE_OBJECT, reg, live);
- }
- hp = p->htop;
- p->htop += FLOAT_SIZE_OBJECT;
- PUT_DOUBLE(f1, hp);
- return make_float(hp);
- default:
- goto badarith;
- }
- default:
- goto badarith;
- }
- }
- default:
- goto badarith;
- }
-}
-
-Eterm
-erts_gc_int_div(Process* p, Eterm* reg, Uint live)
-{
- Eterm arg1;
- Eterm arg2;
- DECLARE_TMP(tmp_big1,0,p);
- DECLARE_TMP(tmp_big2,1,p);
- int ires;
-
- arg1 = reg[live];
- arg2 = reg[live+1];
- switch (NUMBER_CODE(arg1, arg2)) {
- case SMALL_SMALL:
- /* This case occurs if the most negative fixnum is divided by -1. */
- ASSERT(arg2 == make_small(-1));
- arg1 = small_to_big(signed_val(arg1), tmp_big1);
- /*FALLTHROUGH*/
- case BIG_SMALL:
- arg2 = small_to_big(signed_val(arg2), tmp_big2);
- goto L_big_div;
- case SMALL_BIG:
- if (arg1 != make_small(MIN_SMALL)) {
- return SMALL_ZERO;
- }
- arg1 = small_to_big(signed_val(arg1), tmp_big1);
- /*FALLTHROUGH*/
- case BIG_BIG:
- L_big_div:
- ires = big_ucomp(arg1, arg2);
- if (ires < 0) {
- arg1 = SMALL_ZERO;
- } else if (ires == 0) {
- arg1 = (big_sign(arg1) == big_sign(arg2)) ?
- SMALL_ONE : SMALL_MINUS_ONE;
- } else {
- Eterm* hp;
- int i = big_size(arg1);
- Uint need;
-
- ires = big_size(arg2);
- need = BIG_NEED_SIZE(i-ires+1) + BIG_NEED_SIZE(i);
- if (ERTS_NEED_GC(p, need)) {
- erts_garbage_collect(p, need, reg, live+2);
- if (ARG_IS_NOT_TMP(arg1,tmp_big1)) {
- arg1 = reg[live];
- }
- if (ARG_IS_NOT_TMP(arg2,tmp_big2)) {
- arg2 = reg[live+1];
- }
- }
- hp = p->htop;
- p->htop += need;
- arg1 = big_div(arg1, arg2, hp);
- trim_heap(p, hp, arg1);
- if (is_nil(arg1)) {
- p->freason = SYSTEM_LIMIT;
- return THE_NON_VALUE;
- }
- }
- return arg1;
- default:
- p->freason = BADARITH;
- return THE_NON_VALUE;
- }
-}
-
-Eterm
-erts_gc_int_rem(Process* p, Eterm* reg, Uint live)
-{
- Eterm arg1;
- Eterm arg2;
- DECLARE_TMP(tmp_big1,0,p);
- DECLARE_TMP(tmp_big2,1,p);
- int ires;
-
- arg1 = reg[live];
- arg2 = reg[live+1];
- switch (NUMBER_CODE(arg1, arg2)) {
- case BIG_SMALL:
- arg2 = small_to_big(signed_val(arg2), tmp_big2);
- goto L_big_rem;
- case SMALL_BIG:
- if (arg1 != make_small(MIN_SMALL)) {
- return arg1;
- } else {
- Eterm tmp;
- tmp = small_to_big(signed_val(arg1), tmp_big1);
- if ((ires = big_ucomp(tmp, arg2)) == 0) {
- return SMALL_ZERO;
- } else {
- ASSERT(ires < 0);
- return arg1;
- }
- }
- /* All paths returned */
- case BIG_BIG:
- L_big_rem:
- ires = big_ucomp(arg1, arg2);
- if (ires == 0) {
- arg1 = SMALL_ZERO;
- } else if (ires > 0) {
- Eterm* hp;
- Uint need = BIG_NEED_SIZE(big_size(arg1));
-
- if (ERTS_NEED_GC(p, need)) {
- erts_garbage_collect(p, need, reg, live+2);
- if (ARG_IS_NOT_TMP(arg1,tmp_big1)) {
- arg1 = reg[live];
- }
- if (ARG_IS_NOT_TMP(arg2,tmp_big2)) {
- arg2 = reg[live+1];
- }
- }
- hp = p->htop;
- p->htop += need;
- arg1 = big_rem(arg1, arg2, hp);
- trim_heap(p, hp, arg1);
- if (is_nil(arg1)) {
- p->freason = SYSTEM_LIMIT;
- return THE_NON_VALUE;
- }
- }
- return arg1;
- default:
- p->freason = BADARITH;
- return THE_NON_VALUE;
- }
-}
-
-#define DEFINE_GC_LOGIC_FUNC(func) \
-Eterm erts_gc_##func(Process* p, Eterm* reg, Uint live) \
-{ \
- Eterm arg1; \
- Eterm arg2; \
- DECLARE_TMP(tmp_big1,0,p); \
- DECLARE_TMP(tmp_big2,1,p); \
- Eterm* hp; \
- int need; \
- \
- arg1 = reg[live]; \
- arg2 = reg[live+1]; \
- switch (NUMBER_CODE(arg1, arg2)) { \
- case SMALL_BIG: \
- arg1 = small_to_big(signed_val(arg1), tmp_big1); \
- need = BIG_NEED_SIZE(big_size(arg2) + 1); \
- if (ERTS_NEED_GC(p, need)) { \
- erts_garbage_collect(p, need, reg, live+2); \
- arg2 = reg[live+1]; \
- } \
- break; \
- case BIG_SMALL: \
- arg2 = small_to_big(signed_val(arg2), tmp_big2); \
- need = BIG_NEED_SIZE(big_size(arg1) + 1); \
- if (ERTS_NEED_GC(p, need)) { \
- erts_garbage_collect(p, need, reg, live+2); \
- arg1 = reg[live]; \
- } \
- break; \
- case BIG_BIG: \
- need = BIG_NEED_SIZE(MAX(big_size(arg1), big_size(arg2)) + 1); \
- if (ERTS_NEED_GC(p, need)) { \
- erts_garbage_collect(p, need, reg, live+2); \
- arg1 = reg[live]; \
- arg2 = reg[live+1]; \
- } \
- break; \
- default: \
- p->freason = BADARITH; \
- return THE_NON_VALUE; \
- } \
- hp = p->htop; \
- p->htop += need; \
- arg1 = big_##func(arg1, arg2, hp); \
- trim_heap(p, hp, arg1); \
- return arg1; \
-}
-
-DEFINE_GC_LOGIC_FUNC(band)
-DEFINE_GC_LOGIC_FUNC(bor)
-DEFINE_GC_LOGIC_FUNC(bxor)
-
-Eterm erts_gc_bnot(Process* p, Eterm* reg, Uint live)
-{
- Eterm result;
- Eterm arg;
- Uint need;
- Eterm* bigp;
-
- arg = reg[live];
- if (is_not_big(arg)) {
- p->freason = BADARITH;
- return NIL;
- } else {
- need = BIG_NEED_SIZE(big_size(arg)+1);
- if (ERTS_NEED_GC(p, need)) {
- erts_garbage_collect(p, need, reg, live+1);
- arg = reg[live];
- }
- bigp = p->htop;
- p->htop += need;
- result = big_bnot(arg, bigp);
- trim_heap(p, bigp, result);
- if (is_nil(result)) {
- p->freason = SYSTEM_LIMIT;
- return NIL;
- }
- }
- return result;
-}
-
/* Needed to remove compiler optimization */
double erts_get_positive_zero_float() {
return 0.0f;
diff --git a/erts/emulator/beam/erl_bif_binary.c b/erts/emulator/beam/erl_bif_binary.c
index d465f6c6b9..ca1ba55b22 100644
--- a/erts/emulator/beam/erl_bif_binary.c
+++ b/erts/emulator/beam/erl_bif_binary.c
@@ -1970,9 +1970,7 @@ BIF_RETTYPE erts_binary_part(Process *p, Eterm binary, Eterm epos, Eterm elen)
goto badarg;
}
-
-
- hp = HAlloc(p, ERL_SUB_BIN_SIZE);
+ hp = HeapFragOnlyAlloc(p, ERL_SUB_BIN_SIZE);
ERTS_GET_REAL_BIN(binary, orig, offset, bit_offset, bit_size);
sb = (ErlSubBin *) hp;
@@ -1990,100 +1988,6 @@ BIF_RETTYPE erts_binary_part(Process *p, Eterm binary, Eterm epos, Eterm elen)
BIF_ERROR(p, BADARG);
}
-#define ERTS_NEED_GC(p, need) ((HEAP_LIMIT((p)) - HEAP_TOP((p))) <= (need))
-
-BIF_RETTYPE erts_gc_binary_part(Process *p, Eterm *reg, Eterm live, int range_is_tuple)
-{
- Uint pos;
- Sint len;
- size_t orig_size;
- Eterm orig;
- Uint offset;
- Uint bit_offset;
- Uint bit_size;
- Eterm* hp;
- ErlSubBin* sb;
- Eterm binary;
- Eterm *tp;
- Eterm epos, elen;
- int extra_args;
-
-
- if (range_is_tuple) {
- Eterm tpl = reg[live];
- extra_args = 1;
- if (is_not_tuple(tpl)) {
- goto badarg;
- }
- tp = tuple_val(tpl);
- if (arityval(*tp) != 2) {
- goto badarg;
- }
-
- epos = tp[1];
- elen = tp[2];
- } else {
- extra_args = 2;
- epos = reg[live-1];
- elen = reg[live];
- }
- binary = reg[live-extra_args];
-
- if (is_not_binary(binary)) {
- goto badarg;
- }
- if (!term_to_Uint(epos, &pos)) {
- goto badarg;
- }
- if (!term_to_Sint(elen, &len)) {
- goto badarg;
- }
- if (len < 0) {
- Uint lentmp = -(Uint)len;
- /* overflow */
- if ((Sint)lentmp < 0) {
- goto badarg;
- }
- len = lentmp;
- if (len > pos) {
- goto badarg;
- }
- pos -= len;
- }
- /* overflow */
- if ((pos + len) < pos || (len > 0 && (pos + len) == pos)) {
- goto badarg;
- }
- if ((orig_size = binary_size(binary)) < pos ||
- orig_size < (pos + len)) {
- goto badarg;
- }
-
- if (ERTS_NEED_GC(p, ERL_SUB_BIN_SIZE)) {
- erts_garbage_collect(p, ERL_SUB_BIN_SIZE, reg, live+1-extra_args); /* I don't need the tuple
- or indices any more */
- binary = reg[live-extra_args];
- }
-
- hp = p->htop;
- p->htop += ERL_SUB_BIN_SIZE;
-
- ERTS_GET_REAL_BIN(binary, orig, offset, bit_offset, bit_size);
-
- sb = (ErlSubBin *) hp;
- sb->thing_word = HEADER_SUB_BIN;
- sb->size = len;
- sb->offs = offset + pos;
- sb->orig = orig;
- sb->bitoffs = bit_offset;
- sb->bitsize = 0;
- sb->is_writable = 0;
-
- BIF_RET(make_binary(sb));
-
- badarg:
- BIF_ERROR(p, BADARG);
-}
/*************************************************************
* The actual guard BIFs are in erl_bif_guard.c
* but the implementation of both the non-gc and the gc
diff --git a/erts/emulator/beam/erl_bif_guard.c b/erts/emulator/beam/erl_bif_guard.c
index 8a5c6ada6c..84783e71a0 100644
--- a/erts/emulator/beam/erl_bif_guard.c
+++ b/erts/emulator/beam/erl_bif_guard.c
@@ -19,7 +19,12 @@
*/
/*
- * Numeric guard BIFs.
+ * This file implements the former GC BIFs. They used to do a GC when
+ * they needed heap space. Because of changes to the implementation of
+ * literals, those BIFs are now allowed to allocate heap fragments
+ * (using HeapFragOnlyAlloc()). Note that they must NOT call HAlloc(),
+ * because the caller does not do any SWAPIN / SWAPOUT (that is,
+ * HEAP_TOP(p) and HEAP_LIMIT(p) contain stale values).
*/
#ifdef HAVE_CONFIG_H
@@ -36,15 +41,8 @@
#include "erl_binary.h"
#include "erl_map.h"
-static Eterm gc_double_to_integer(Process* p, double x, Eterm* reg, Uint live);
-
static Eterm double_to_integer(Process* p, double x);
-/*
- * Guard BIFs called using apply/3 and guard BIFs that never build
- * anything on the heap.
- */
-
BIF_RETTYPE abs_1(BIF_ALIST_1)
{
Eterm res;
@@ -56,7 +54,7 @@ BIF_RETTYPE abs_1(BIF_ALIST_1)
i0 = signed_val(BIF_ARG_1);
i = ERTS_SMALL_ABS(i0);
if (i0 == MIN_SMALL) {
- hp = HAlloc(BIF_P, BIG_UINT_HEAP_SIZE);
+ hp = HeapFragOnlyAlloc(BIF_P, BIG_UINT_HEAP_SIZE);
BIF_RET(uint_to_big(i, hp));
} else {
BIF_RET(make_small(i));
@@ -68,7 +66,7 @@ BIF_RETTYPE abs_1(BIF_ALIST_1)
int sz = big_arity(BIF_ARG_1) + 1;
Uint* x;
- hp = HAlloc(BIF_P, sz); /* See note at beginning of file */
+ hp = HeapFragOnlyAlloc(BIF_P, sz); /* See note at beginning of file */
sz--;
res = make_big(hp);
x = big_val(BIF_ARG_1);
@@ -83,7 +81,7 @@ BIF_RETTYPE abs_1(BIF_ALIST_1)
GET_DOUBLE(BIF_ARG_1, f);
if (f.fd < 0.0) {
- hp = HAlloc(BIF_P, FLOAT_SIZE_OBJECT);
+ hp = HeapFragOnlyAlloc(BIF_P, FLOAT_SIZE_OBJECT);
f.fd = fabs(f.fd);
res = make_float(hp);
PUT_DOUBLE(f, hp);
@@ -116,7 +114,7 @@ BIF_RETTYPE float_1(BIF_ALIST_1)
} else if (big_to_double(BIF_ARG_1, &f.fd) < 0) {
goto badarg;
}
- hp = HAlloc(BIF_P, FLOAT_SIZE_OBJECT);
+ hp = HeapFragOnlyAlloc(BIF_P, FLOAT_SIZE_OBJECT);
res = make_float(hp);
PUT_DOUBLE(f, hp);
BIF_RET(res);
@@ -229,7 +227,7 @@ BIF_RETTYPE size_1(BIF_ALIST_1)
if (IS_USMALL(0, sz)) {
return make_small(sz);
} else {
- Eterm* hp = HAlloc(BIF_P, BIG_UINT_HEAP_SIZE);
+ Eterm* hp = HeapFragOnlyAlloc(BIF_P, BIG_UINT_HEAP_SIZE);
BIF_RET(uint_to_big(sz, hp));
}
}
@@ -252,12 +250,12 @@ BIF_RETTYPE bit_size_1(BIF_ALIST_1)
if (IS_USMALL(0,low_bits)) {
BIF_RET(make_small(low_bits));
} else {
- Eterm* hp = HAlloc(BIF_P, BIG_UINT_HEAP_SIZE);
+ Eterm* hp = HeapFragOnlyAlloc(BIF_P, BIG_UINT_HEAP_SIZE);
BIF_RET(uint_to_big(low_bits, hp));
}
} else {
Uint sz = BIG_UINT_HEAP_SIZE+1;
- Eterm* hp = HAlloc(BIF_P, sz);
+ Eterm* hp = HeapFragOnlyAlloc(BIF_P, sz);
hp[0] = make_pos_bignum_header(sz-1);
BIG_DIGIT(hp,0) = low_bits;
BIG_DIGIT(hp,1) = high_bits;
@@ -281,7 +279,7 @@ BIF_RETTYPE byte_size_1(BIF_ALIST_1)
if (IS_USMALL(0, bytesize)) {
BIF_RET(make_small(bytesize));
} else {
- Eterm* hp = HAlloc(BIF_P, BIG_UINT_HEAP_SIZE);
+ Eterm* hp = HeapFragOnlyAlloc(BIF_P, BIG_UINT_HEAP_SIZE);
BIF_RET(uint_to_big(bytesize, hp));
}
} else {
@@ -325,7 +323,7 @@ double_to_integer(Process* p, double x)
}
sz = BIG_NEED_SIZE(ds); /* number of words including arity */
- hp = HAlloc(p, sz);
+ hp = HeapFragOnlyAlloc(p, sz);
res = make_big(hp);
xp = (ErtsDigit*) (hp + 1);
@@ -371,389 +369,3 @@ BIF_RETTYPE binary_part_2(BIF_ALIST_2)
badarg:
BIF_ERROR(BIF_P,BADARG);
}
-
-
-/*
- * The following code is used when a guard that may build on the
- * heap is called directly. They must not use HAlloc(), but must
- * do a garbage collection if there is insufficient heap space.
- *
- * Important note: All error checking MUST be done before doing
- * a garbage collection. The compiler assumes that all registers
- * are still valid if a guard BIF generates an exception.
- */
-
-#define ERTS_NEED_GC(p, need) ((HEAP_LIMIT((p)) - HEAP_TOP((p))) <= (need))
-
-Eterm erts_gc_length_1(Process* p, Eterm* reg, Uint live)
-{
- Eterm list = reg[live];
- int i;
-
- if (is_nil(list))
- return SMALL_ZERO;
- i = 0;
- while (is_list(list)) {
- i++;
- list = CDR(list_val(list));
- }
- if (is_not_nil(list)) {
- BIF_ERROR(p, BADARG);
- }
- return make_small(i);
-}
-
-Eterm erts_gc_size_1(Process* p, Eterm* reg, Uint live)
-{
- Eterm arg = reg[live];
- if (is_tuple(arg)) {
- Eterm* tupleptr = tuple_val(arg);
- return make_small(arityval(*tupleptr));
- } else if (is_binary(arg)) {
- Uint sz = binary_size(arg);
- if (IS_USMALL(0, sz)) {
- return make_small(sz);
- } else {
- Eterm* hp;
- if (ERTS_NEED_GC(p, BIG_UINT_HEAP_SIZE)) {
- erts_garbage_collect(p, BIG_UINT_HEAP_SIZE, reg, live);
- }
- hp = p->htop;
- p->htop += BIG_UINT_HEAP_SIZE;
- return uint_to_big(sz, hp);
- }
- }
- BIF_ERROR(p, BADARG);
-}
-
-Eterm erts_gc_bit_size_1(Process* p, Eterm* reg, Uint live)
-{
- Eterm arg = reg[live];
- if (is_binary(arg)) {
- Uint low_bits;
- Uint bytesize;
- Uint high_bits;
- bytesize = binary_size(arg);
- high_bits = bytesize >> ((sizeof(Uint) * 8)-3);
- low_bits = (bytesize << 3) + binary_bitsize(arg);
- if (high_bits == 0) {
- if (IS_USMALL(0,low_bits)) {
- return make_small(low_bits);
- } else {
- Eterm* hp;
- if (ERTS_NEED_GC(p, BIG_UINT_HEAP_SIZE)) {
- erts_garbage_collect(p, BIG_UINT_HEAP_SIZE, reg, live);
- }
- hp = p->htop;
- p->htop += BIG_UINT_HEAP_SIZE;
- return uint_to_big(low_bits, hp);
- }
- } else {
- Uint sz = BIG_UINT_HEAP_SIZE+1;
- Eterm* hp;
- if (ERTS_NEED_GC(p, sz)) {
- erts_garbage_collect(p, sz, reg, live);
- }
- hp = p->htop;
- p->htop += sz;
- hp[0] = make_pos_bignum_header(sz-1);
- BIG_DIGIT(hp,0) = low_bits;
- BIG_DIGIT(hp,1) = high_bits;
- return make_big(hp);
- }
- } else {
- BIF_ERROR(p, BADARG);
- }
-}
-
-Eterm erts_gc_byte_size_1(Process* p, Eterm* reg, Uint live)
-{
- Eterm arg = reg[live];
- if (is_binary(arg)) {
- Uint bytesize = binary_size(arg);
- if (binary_bitsize(arg) > 0) {
- bytesize++;
- }
- if (IS_USMALL(0, bytesize)) {
- return make_small(bytesize);
- } else {
- Eterm* hp;
- if (ERTS_NEED_GC(p, BIG_UINT_HEAP_SIZE)) {
- erts_garbage_collect(p, BIG_UINT_HEAP_SIZE, reg, live);
- }
- hp = p->htop;
- p->htop += BIG_UINT_HEAP_SIZE;
- return uint_to_big(bytesize, hp);
- }
- } else {
- BIF_ERROR(p, BADARG);
- }
-}
-
-Eterm erts_gc_map_size_1(Process* p, Eterm* reg, Uint live)
-{
- Eterm arg = reg[live];
- if (is_flatmap(arg)) {
- flatmap_t *mp = (flatmap_t*)flatmap_val(arg);
- return make_small(flatmap_get_size(mp));
- } else if (is_hashmap(arg)) {
- Eterm* hp;
- Uint size;
- size = hashmap_size(arg);
- if (IS_USMALL(0, size)) {
- return make_small(size);
- }
- if (ERTS_NEED_GC(p, BIG_UINT_HEAP_SIZE)) {
- erts_garbage_collect(p, BIG_UINT_HEAP_SIZE, reg, live);
- }
- hp = p->htop;
- p->htop += BIG_UINT_HEAP_SIZE;
- return uint_to_big(size, hp);
- }
- p->fvalue = arg;
- BIF_ERROR(p, BADMAP);
-}
-
-Eterm erts_gc_abs_1(Process* p, Eterm* reg, Uint live)
-{
- Eterm arg;
- Eterm res;
- Sint i0, i;
- Eterm* hp;
-
- arg = reg[live];
-
- /* integer arguments */
- if (is_small(arg)) {
- i0 = signed_val(arg);
- i = ERTS_SMALL_ABS(i0);
- if (i0 == MIN_SMALL) {
- if (ERTS_NEED_GC(p, BIG_UINT_HEAP_SIZE)) {
- erts_garbage_collect(p, BIG_UINT_HEAP_SIZE, reg, live+1);
- arg = reg[live];
- }
- hp = p->htop;
- p->htop += BIG_UINT_HEAP_SIZE;
- return uint_to_big(i, hp);
- } else {
- return make_small(i);
- }
- } else if (is_big(arg)) {
- if (!big_sign(arg)) {
- return arg;
- } else {
- int sz = big_arity(arg) + 1;
- Uint* x;
-
- if (ERTS_NEED_GC(p, sz)) {
- erts_garbage_collect(p, sz, reg, live+1);
- arg = reg[live];
- }
- hp = p->htop;
- p->htop += sz;
- sz--;
- res = make_big(hp);
- x = big_val(arg);
- *hp++ = make_pos_bignum_header(sz);
- x++; /* skip thing */
- while(sz--)
- *hp++ = *x++;
- return res;
- }
- } else if (is_float(arg)) {
- FloatDef f;
-
- GET_DOUBLE(arg, f);
- if (f.fd < 0.0) {
- if (ERTS_NEED_GC(p, FLOAT_SIZE_OBJECT)) {
- erts_garbage_collect(p, FLOAT_SIZE_OBJECT, reg, live+1);
- arg = reg[live];
- }
- hp = p->htop;
- p->htop += FLOAT_SIZE_OBJECT;
- f.fd = fabs(f.fd);
- res = make_float(hp);
- PUT_DOUBLE(f, hp);
- return res;
- }
- else
- return arg;
- }
- BIF_ERROR(p, BADARG);
-}
-
-Eterm erts_gc_float_1(Process* p, Eterm* reg, Uint live)
-{
- Eterm arg;
- Eterm res;
- Eterm* hp;
- FloatDef f;
-
- /* check args */
- arg = reg[live];
- if (is_not_integer(arg)) {
- if (is_float(arg)) {
- return arg;
- } else {
- badarg:
- BIF_ERROR(p, BADARG);
- }
- }
- if (is_small(arg)) {
- Sint i = signed_val(arg);
- f.fd = i; /* use "C"'s auto casting */
- } else if (big_to_double(arg, &f.fd) < 0) {
- goto badarg;
- }
- if (ERTS_NEED_GC(p, FLOAT_SIZE_OBJECT)) {
- erts_garbage_collect(p, FLOAT_SIZE_OBJECT, reg, live+1);
- arg = reg[live];
- }
- hp = p->htop;
- p->htop += FLOAT_SIZE_OBJECT;
- res = make_float(hp);
- PUT_DOUBLE(f, hp);
- return res;
-}
-
-Eterm erts_gc_round_1(Process* p, Eterm* reg, Uint live)
-{
- Eterm arg;
- FloatDef f;
-
- arg = reg[live];
- if (is_not_float(arg)) {
- if (is_integer(arg)) {
- return arg;
- }
- BIF_ERROR(p, BADARG);
- }
- GET_DOUBLE(arg, f);
-
- return gc_double_to_integer(p, round(f.fd), reg, live);
-}
-
-Eterm erts_gc_trunc_1(Process* p, Eterm* reg, Uint live)
-{
- Eterm arg;
- FloatDef f;
-
- arg = reg[live];
- if (is_not_float(arg)) {
- if (is_integer(arg)) {
- return arg;
- }
- BIF_ERROR(p, BADARG);
- }
- /* get the float */
- GET_DOUBLE(arg, f);
-
- /* truncate it and return the resultant integer */
- return gc_double_to_integer(p, (f.fd >= 0.0) ? floor(f.fd) : ceil(f.fd),
- reg, live);
-}
-
-Eterm erts_gc_floor_1(Process* p, Eterm* reg, Uint live)
-{
- Eterm arg;
- FloatDef f;
-
- arg = reg[live];
- if (is_not_float(arg)) {
- if (is_integer(arg)) {
- return arg;
- }
- BIF_ERROR(p, BADARG);
- }
- GET_DOUBLE(arg, f);
- return gc_double_to_integer(p, floor(f.fd), reg, live);
-}
-
-Eterm erts_gc_ceil_1(Process* p, Eterm* reg, Uint live)
-{
- Eterm arg;
- FloatDef f;
-
- arg = reg[live];
- if (is_not_float(arg)) {
- if (is_integer(arg)) {
- return arg;
- }
- BIF_ERROR(p, BADARG);
- }
- GET_DOUBLE(arg, f);
- return gc_double_to_integer(p, ceil(f.fd), reg, live);
-}
-
-static Eterm
-gc_double_to_integer(Process* p, double x, Eterm* reg, Uint live)
-{
- int is_negative;
- int ds;
- ErtsDigit* xp;
- int i;
- Eterm res;
- size_t sz;
- Eterm* hp;
- double dbase;
-
- if ((x < (double) (MAX_SMALL+1)) && (x > (double) (MIN_SMALL-1))) {
- Sint xi = x;
- return make_small(xi);
- }
-
- if (x >= 0) {
- is_negative = 0;
- } else {
- is_negative = 1;
- x = -x;
- }
-
- /* Unscale & (calculate exponent) */
- ds = 0;
- dbase = ((double)(D_MASK)+1);
- while(x >= 1.0) {
- x /= dbase; /* "shift" right */
- ds++;
- }
- sz = BIG_NEED_SIZE(ds); /* number of words including arity */
- if (ERTS_NEED_GC(p, sz)) {
- erts_garbage_collect(p, sz, reg, live);
- }
- hp = p->htop;
- p->htop += sz;
- res = make_big(hp);
- xp = (ErtsDigit*) (hp + 1);
-
- for (i = ds-1; i >= 0; i--) {
- ErtsDigit d;
-
- x *= dbase; /* "shift" left */
- d = x; /* trunc */
- xp[i] = d; /* store digit */
- x -= d; /* remove integer part */
- }
- while ((ds & (BIG_DIGITS_PER_WORD-1)) != 0) {
- xp[ds++] = 0;
- }
-
- if (is_negative) {
- *hp = make_neg_bignum_header(sz-1);
- } else {
- *hp = make_pos_bignum_header(sz-1);
- }
- return res;
-}
-
-/********************************************************************************
- * binary_part guards. The actual implementation is in erl_bif_binary.c
- ********************************************************************************/
-Eterm erts_gc_binary_part_3(Process* p, Eterm* reg, Uint live)
-{
- return erts_gc_binary_part(p,reg,live,0);
-}
-
-Eterm erts_gc_binary_part_2(Process* p, Eterm* reg, Uint live)
-{
- return erts_gc_binary_part(p,reg,live,1);
-}
diff --git a/erts/emulator/beam/erl_binary.h b/erts/emulator/beam/erl_binary.h
index 08edb43c49..4bf77988f7 100644
--- a/erts/emulator/beam/erl_binary.h
+++ b/erts/emulator/beam/erl_binary.h
@@ -278,7 +278,6 @@ Eterm erts_bin_bytes_to_list(Eterm previous, Eterm* hp, byte* bytes, Uint size,
*/
BIF_RETTYPE erts_list_to_binary_bif(Process *p, Eterm arg, Export *bif);
-BIF_RETTYPE erts_gc_binary_part(Process *p, Eterm *reg, Eterm live, int range_is_tuple);
BIF_RETTYPE erts_binary_part(Process *p, Eterm binary, Eterm epos, Eterm elen);
diff --git a/erts/emulator/beam/erl_map.c b/erts/emulator/beam/erl_map.c
index 3d6c9eb43f..93816542cd 100644
--- a/erts/emulator/beam/erl_map.c
+++ b/erts/emulator/beam/erl_map.c
@@ -125,15 +125,20 @@ BIF_RETTYPE map_size_1(BIF_ALIST_1) {
flatmap_t *mp = (flatmap_t*)flatmap_val(BIF_ARG_1);
BIF_RET(make_small(flatmap_get_size(mp)));
} else if (is_hashmap(BIF_ARG_1)) {
- Eterm *head, *hp, res;
- Uint size, hsz=0;
+ Eterm *head;
+ Uint size;
head = hashmap_val(BIF_ARG_1);
size = head[1];
- (void) erts_bld_uint(NULL, &hsz, size);
- hp = HAlloc(BIF_P, hsz);
- res = erts_bld_uint(&hp, NULL, size);
- BIF_RET(res);
+
+ /*
+ * As long as a small has 28 bits (on a 32-bit machine) for
+ * the integer itself, it is impossible to build a map whose
+ * size would not fit in a small. Add an assertion in case we
+ * ever decreases the number of bits in a small.
+ */
+ ASSERT(IS_USMALL(0, size));
+ BIF_RET(make_small(size));
}
BIF_P->fvalue = BIF_ARG_1;
diff --git a/erts/emulator/beam/erl_vm.h b/erts/emulator/beam/erl_vm.h
index 4089fac48e..fd46a804d3 100644
--- a/erts/emulator/beam/erl_vm.h
+++ b/erts/emulator/beam/erl_vm.h
@@ -146,6 +146,21 @@
(HEAP_TOP(p) = HEAP_TOP(p) + (sz), HEAP_TOP(p) - (sz))))
#endif
+/*
+ * Always allocate in a heap fragment, never on the heap.
+ */
+#if defined(VALGRIND)
+/* Running under valgrind, allocate exactly as much as needed.*/
+# define HeapFragOnlyAlloc(p, sz) \
+ (ASSERT((sz) >= 0), \
+ ErtsHAllocLockCheck(p), \
+ erts_heap_alloc((p),(sz),0))
+#else
+# define HeapFragOnlyAlloc(p, sz) \
+ (ASSERT((sz) >= 0), \
+ ErtsHAllocLockCheck(p), \
+ erts_heap_alloc((p),(sz),512))
+#endif
/*
* Description for each instruction (defined here because the name and
diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab
index 349034e8ac..fbed2e56e1 100644
--- a/erts/emulator/beam/ops.tab
+++ b/erts/emulator/beam/ops.tab
@@ -1002,10 +1002,11 @@ bif1 Fail Bif=u$bif:erlang:get/1 Src=s Dst=d => gen_get(Src, Dst)
bif2 Jump=j u$bif:erlang:element/2 S1=s S2=xy Dst=d => gen_element(Jump, S1, S2, Dst)
-bif1 p Bif S1 Dst => bif1_body Bif S1 Dst
+bif1 p Bif S1 Dst => i_bif1_body Bif S1 Dst
+bif1 Fail=f Bif S1 Dst => i_bif1 Fail Bif S1 Dst
-bif2 p Bif S1 S2 Dst => i_bif2_body Bif S1 S2 Dst
-bif2 Fail Bif S1 S2 Dst => i_bif2 Fail Bif S1 S2 Dst
+bif2 p Bif S1 S2 Dst => i_bif2_body Bif S1 S2 Dst
+bif2 Fail=f Bif S1 S2 Dst => i_bif2 Fail Bif S1 S2 Dst
i_get_hash c I d
i_get s d
@@ -1023,10 +1024,12 @@ i_fast_element xy j? I d
i_element xy j? s d
-bif1 f? b s d
-bif1_body b s d
+i_bif1 f? b s d
+i_bif1_body b s d
i_bif2 f? b s s d
i_bif2_body b s s d
+i_bif3 f? b s s s d
+i_bif3_body b s s s d
#
# Internal calls.
@@ -1499,80 +1502,80 @@ gc_bif2 Fail Live u$bif:erlang:sminus/2 S1 S2 Dst => \
#
# Optimize addition and subtraction of small literals using
-# the i_increment/4 instruction (in bodies, not in guards).
+# the i_increment/3 instruction (in bodies, not in guards).
#
gen_plus p Live Int=i Reg=d Dst => \
- gen_increment(Reg, Int, Live, Dst)
+ gen_increment(Reg, Int, Dst)
gen_plus p Live Reg=d Int=i Dst => \
- gen_increment(Reg, Int, Live, Dst)
+ gen_increment(Reg, Int, Dst)
gen_minus p Live Reg=d Int=i Dst | negation_is_small(Int) => \
- gen_increment_from_minus(Reg, Int, Live, Dst)
+ gen_increment_from_minus(Reg, Int, Dst)
#
-# GCing arithmetic instructions.
+# Arithmetic instructions.
#
-gen_plus Fail Live S1 S2 Dst => i_plus S1 S2 Fail Live Dst
+gen_plus Fail Live S1 S2 Dst => i_plus S1 S2 Fail Dst
-gen_minus Fail Live S1 S2 Dst => i_minus S1 S2 Fail Live Dst
+gen_minus Fail Live S1 S2 Dst => i_minus S1 S2 Fail Dst
gc_bif2 Fail Live u$bif:erlang:stimes/2 S1 S2 Dst => \
- i_times Fail Live S1 S2 Dst
+ i_times Fail S1 S2 Dst
gc_bif2 Fail Live u$bif:erlang:div/2 S1 S2 Dst => \
- i_m_div Fail Live S1 S2 Dst
+ i_m_div Fail S1 S2 Dst
gc_bif2 Fail Live u$bif:erlang:intdiv/2 S1 S2 Dst => \
- i_int_div Fail Live S1 S2 Dst
+ i_int_div Fail S1 S2 Dst
gc_bif2 Fail Live u$bif:erlang:rem/2 S1 S2 Dst => \
- i_rem S1 S2 Fail Live Dst
+ i_rem S1 S2 Fail Dst
gc_bif2 Fail Live u$bif:erlang:bsl/2 S1 S2 Dst => \
- i_bsl S1 S2 Fail Live Dst
+ i_bsl S1 S2 Fail Dst
gc_bif2 Fail Live u$bif:erlang:bsr/2 S1 S2 Dst => \
- i_bsr S1 S2 Fail Live Dst
+ i_bsr S1 S2 Fail Dst
gc_bif2 Fail Live u$bif:erlang:band/2 S1 S2 Dst => \
- i_band S1 S2 Fail Live Dst
+ i_band S1 S2 Fail Dst
gc_bif2 Fail Live u$bif:erlang:bor/2 S1 S2 Dst => \
- i_bor Fail Live S1 S2 Dst
+ i_bor Fail S1 S2 Dst
gc_bif2 Fail Live u$bif:erlang:bxor/2 S1 S2 Dst => \
- i_bxor Fail Live S1 S2 Dst
+ i_bxor Fail S1 S2 Dst
-gc_bif1 Fail I u$bif:erlang:bnot/1 Src Dst=d => i_int_bnot Fail Src I Dst
+gc_bif1 Fail Live u$bif:erlang:bnot/1 Src Dst=d => i_int_bnot Fail Src Dst
-i_increment rxy W t d
+i_increment rxy W d
-i_plus x xy j? t d
-i_plus s s j? t d
+i_plus x xy j? d
+i_plus s s j? d
-i_minus x x j? t d
-i_minus s s j? t d
+i_minus x x j? d
+i_minus s s j? d
-i_times j? t s s d
+i_times j? s s d
-i_m_div j? t s s d
-i_int_div j? t s s d
+i_m_div j? s s d
+i_int_div j? s s d
-i_rem x x j? t d
-i_rem s s j? t d
+i_rem x x j? d
+i_rem s s j? d
-i_bsl s s j? t d
-i_bsr s s j? t d
+i_bsl s s j? d
+i_bsr s s j? d
-i_band x c j? t d
-i_band s s j? t d
+i_band x c j? d
+i_band s s j? d
-i_bor j? I s s d
-i_bxor j? I s s d
+i_bor j? s s d
+i_bxor j? s s d
-i_int_bnot Fail Src=c Live Dst => move Src x | i_int_bnot Fail x Live Dst
+i_int_bnot Fail Src=c Dst => move Src x | i_int_bnot Fail x Dst
-i_int_bnot j? S t d
+i_int_bnot j? S d
#
# Old guard BIFs that creates heap fragments are no longer allowed.
@@ -1587,27 +1590,14 @@ bif1 Fail u$bif:erlang:trunc/1 s d => too_old_compiler
#
# Guard BIFs.
#
-gc_bif1 Fail I Bif Src Dst => \
- gen_guard_bif1(Fail, I, Bif, Src, Dst)
+gc_bif1 p Live Bif Src Dst => i_bif1_body Bif Src Dst
+gc_bif1 Fail=f Live Bif Src Dst => i_bif1 Fail Bif Src Dst
-gc_bif2 Fail I Bif S1 S2 Dst => \
- gen_guard_bif2(Fail, I, Bif, S1, S2, Dst)
+gc_bif2 p Live Bif S1 S2 Dst => i_bif2_body Bif S1 S2 Dst
+gc_bif2 Fail=f Live Bif S1 S2 Dst => i_bif2 Fail Bif S1 S2 Dst
-gc_bif3 Fail I Bif S1 S2 S3 Dst => \
- gen_guard_bif3(Fail, I, Bif, S1, S2, S3, Dst)
-
-i_gc_bif1 j? W s t? d
-
-i_gc_bif2 j? W t? s s d
-
-ii_gc_bif3/7
-
-# A specific instruction can only have 6 operands, so we must
-# pass one of the arguments in an x register.
-ii_gc_bif3 Fail Bif Live S1 S2 S3 Dst => \
- move S1 x | i_gc_bif3 Fail Bif Live S2 S3 Dst
-
-i_gc_bif3 j? W t? s s d
+gc_bif3 p Live Bif S1 S2 S3 Dst => i_bif3_body Bif S1 S2 S3 Dst
+gc_bif3 Fail=f Live Bif S1 S2 S3 Dst => i_bif3 Fail Bif S1 S2 S3 Dst
#
# The following instruction is specially handled in beam_load.c