aboutsummaryrefslogtreecommitdiffstats
path: root/erts/emulator/beam
diff options
context:
space:
mode:
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