diff options
author | Björn Gustavsson <[email protected]> | 2017-05-20 17:59:03 +0200 |
---|---|---|
committer | Björn Gustavsson <[email protected]> | 2017-08-11 13:44:47 +0200 |
commit | 81a6adab693a75f89bc87911ac23a21308673d2d (patch) | |
tree | f0fcf793984c34b69a9c2f111c42d25e87605f34 /erts/emulator | |
parent | e1be82aba88fd01926bcfc88757ae3257eadaf16 (diff) | |
download | otp-81a6adab693a75f89bc87911ac23a21308673d2d.tar.gz otp-81a6adab693a75f89bc87911ac23a21308673d2d.tar.bz2 otp-81a6adab693a75f89bc87911ac23a21308673d2d.zip |
Break out most instructions from beam_emu.c
Diffstat (limited to 'erts/emulator')
-rw-r--r-- | erts/emulator/Makefile.in | 18 | ||||
-rw-r--r-- | erts/emulator/beam/arith_instrs.tab | 393 | ||||
-rw-r--r-- | erts/emulator/beam/beam_emu.c | 3610 | ||||
-rw-r--r-- | erts/emulator/beam/beam_load.c | 51 | ||||
-rw-r--r-- | erts/emulator/beam/bif_instrs.tab | 539 | ||||
-rw-r--r-- | erts/emulator/beam/bs_instrs.tab | 888 | ||||
-rw-r--r-- | erts/emulator/beam/float_instrs.tab | 88 | ||||
-rw-r--r-- | erts/emulator/beam/instrs.tab | 509 | ||||
-rw-r--r-- | erts/emulator/beam/macros.tab | 139 | ||||
-rw-r--r-- | erts/emulator/beam/map_instrs.tab | 162 | ||||
-rw-r--r-- | erts/emulator/beam/msg_instrs.tab | 382 | ||||
-rw-r--r-- | erts/emulator/beam/ops.tab | 86 | ||||
-rw-r--r-- | erts/emulator/beam/select_instrs.tab | 196 | ||||
-rw-r--r-- | erts/emulator/beam/trace_instrs.tab | 155 | ||||
-rw-r--r-- | erts/emulator/hipe/hipe_instrs.tab | 141 |
15 files changed, 3585 insertions, 3772 deletions
diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in index 015a3a42ed..c6511a4b49 100644 --- a/erts/emulator/Makefile.in +++ b/erts/emulator/Makefile.in @@ -28,10 +28,22 @@ HIPE_ENABLED=@HIPE_ENABLED@ DTRACE_ENABLED=@DTRACE_ENABLED@ DTRACE_ENABLED_2STEP=@DTRACE_ENABLED_2STEP@ USE_VM_PROBES=@USE_VM_PROBES@ +FPE=@FPE@ LIBS = @LIBS@ Z_LIB=@Z_LIB@ NO_INLINE_FUNCTIONS=false -OPCODE_TABLES = $(ERL_TOP)/lib/compiler/src/genop.tab beam/ops.tab beam/instrs.tab beam/bs_instrs.tab +OPCODE_TABLES = $(ERL_TOP)/lib/compiler/src/genop.tab \ +beam/ops.tab \ +beam/macros.tab \ +beam/instrs.tab \ +beam/arith_instrs.tab \ +beam/bif_instrs.tab \ +beam/bs_instrs.tab \ +beam/float_instrs.tab \ +beam/map_instrs.tab \ +beam/msg_instrs.tab \ +beam/select_instrs.tab \ +beam/trace_instrs.tab DEBUG_CFLAGS = @DEBUG_CFLAGS@ CONFIGURE_CFLAGS = @CFLAGS@ @@ -529,11 +541,12 @@ DTRACE_HEADERS = endif ifdef HIPE_ENABLED -OPCODE_TABLES += hipe/hipe_ops.tab +OPCODE_TABLES += hipe/hipe_ops.tab hipe/hipe_instrs.tab endif $(TTF_DIR)/beam_cold.h \ $(TTF_DIR)/beam_hot.h \ +$(TTF_DIR)/beam_instrs.h \ $(TTF_DIR)/beam_opcodes.c \ $(TTF_DIR)/beam_opcodes.h \ $(TTF_DIR)/beam_pred_funcs.h \ @@ -544,6 +557,7 @@ $(TTF_DIR)/OPCODES-GENERATED: $(OPCODE_TABLES) utils/beam_makeops -wordsize @EXTERNAL_WORD_SIZE@ \ -outdir $(TTF_DIR) \ -DUSE_VM_PROBES=$(if $(USE_VM_PROBES),1,0) \ + -DNO_FPE_SIGNALS=$(if $filter(unreliable,$(FPE)),1,0) \ -emulator $(OPCODE_TABLES) && echo $? >$(TTF_DIR)/OPCODES-GENERATED GENERATE += $(TTF_DIR)/OPCODES-GENERATED diff --git a/erts/emulator/beam/arith_instrs.tab b/erts/emulator/beam/arith_instrs.tab new file mode 100644 index 0000000000..91fe21e161 --- /dev/null +++ b/erts/emulator/beam/arith_instrs.tab @@ -0,0 +1,393 @@ +// -*- c -*- +// +// %CopyrightBegin% +// +// Copyright Ericsson AB 2017. All Rights Reserved. +// +// Licensed under the Apache License, Version 2.0 (the "License"); +// you may not use this file except in compliance with the License. +// You may obtain a copy of the License at +// +// http://www.apache.org/licenses/LICENSE-2.0 +// +// Unless required by applicable law or agreed to in writing, software +// distributed under the License is distributed on an "AS IS" BASIS, +// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +// See the License for the specific language governing permissions and +// limitations under the License. +// +// %CopyrightEnd% +// + +OUTLINED_ARITH_2(Fail, Live, 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; + ERTS_HOLE_CHECK(c_p); + if (is_value(result)) { + $REFRESH_GEN_DEST(); + $Dst = result; + $NEXT0(); + } + $BIF_ERROR_ARITY_2($Fail, $BIF, reg[live], reg[live+1]); +} + + +i_plus := plus.fetch.execute; + +plus.head() { + Eterm PlusOp1, PlusOp2; +} + +plus.fetch(Op1, Op2) { + PlusOp1 = $Op1; + PlusOp2 = $Op2; +} + +plus.execute(Fail, Live, Dst) { + if (is_both_small(PlusOp1, PlusOp2)) { + Sint i = signed_val(PlusOp1) + signed_val(PlusOp2); + ASSERT(MY_IS_SSMALL(i) == IS_SSMALL(i)); + if (MY_IS_SSMALL(i)) { + $Dst = make_small(i); + $NEXT0(); + } + } + $OUTLINED_ARITH_2($Fail, $Live, mixed_plus, BIF_splus_2, PlusOp1, PlusOp2, $Dst); +} + +i_minus := minus.fetch.execute; + +minus.head() { + Eterm MinusOp1, MinusOp2; +} + +minus.fetch(Op1, Op2) { + MinusOp1 = $Op1; + MinusOp2 = $Op2; +} + +minus.execute(Fail, Live, Dst) { + if (is_both_small(MinusOp1, MinusOp2)) { + Sint i = signed_val(MinusOp1) - signed_val(MinusOp2); + ASSERT(MY_IS_SSMALL(i) == IS_SSMALL(i)); + if (MY_IS_SSMALL(i)) { + $Dst = make_small(i); + $NEXT0(); + } + } + $OUTLINED_ARITH_2($Fail, $Live, mixed_minus, BIF_sminus_2, MinusOp1, MinusOp2, $Dst); +} + +i_increment := increment.fetch.execute; + +increment.head() { + Eterm increment_reg_val; + Eterm increment_val; + Uint live; + Eterm result; +} + +increment.fetch(Src) { + increment_reg_val = $Src; +} + +increment.execute(IncrementVal, Live, Dst) { + increment_val = $IncrementVal; + if (is_small(increment_reg_val)) { + Sint i = signed_val(increment_reg_val) + increment_val; + ASSERT(MY_IS_SSMALL(i) == IS_SSMALL(i)); + if (MY_IS_SSMALL(i)) { + $Dst = make_small(i); + $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; + ERTS_HOLE_CHECK(c_p); + if (is_value(result)) { + $REFRESH_GEN_DEST(); + $Dst = result; + $NEXT0(); + } + ASSERT(c_p->freason != BADMATCH || is_value(c_p->fvalue)); + goto find_func_info; +} + +i_times(Fail, Live, Op1, Op2, Dst) { + Eterm op1 = $Op1; + Eterm op2 = $Op2; + $OUTLINED_ARITH_2($Fail, $Live, mixed_times, BIF_stimes_2, op1, op2, $Dst); +} + +i_m_div(Fail, Live, Op1, Op2, Dst) { + Eterm op1 = $Op1; + Eterm op2 = $Op2; + $OUTLINED_ARITH_2($Fail, $Live, mixed_div, BIF_div_2, op1, op2, $Dst); +} + +i_int_div(Fail, Live, Op1, Op2, Dst) { + Eterm op1 = $Op1; + Eterm op2 = $Op2; + if (op2 == SMALL_ZERO) { + c_p->freason = BADARITH; + $BIF_ERROR_ARITY_2($Fail, BIF_intdiv_2, op1, op2); + } else if (is_both_small(op1, op2)) { + Sint ires = signed_val(op1) / signed_val(op2); + if (MY_IS_SSMALL(ires)) { + $Dst = make_small(ires); + $NEXT0(); + } + } + $OUTLINED_ARITH_2($Fail, $Live, int_div, BIF_intdiv_2, op1, op2, $Dst); +} + +i_rem := rem.fetch.execute; + +rem.head() { + Eterm RemOp1, RemOp2; +} + +rem.fetch(Src1, Src2) { + RemOp1 = $Src1; + RemOp2 = $Src2; +} + +rem.execute(Fail, Live, Dst) { + if (RemOp2 == SMALL_ZERO) { + c_p->freason = BADARITH; + $BIF_ERROR_ARITY_2($Fail, BIF_rem_2, RemOp1, RemOp2); + } else if (is_both_small(RemOp1, RemOp2)) { + $Dst = make_small(signed_val(RemOp1) % signed_val(RemOp2)); + $NEXT0(); + } else { + $OUTLINED_ARITH_2($Fail, $Live, int_rem, BIF_rem_2, RemOp1, RemOp2, $Dst); + } +} + +i_band := band.fetch.execute; + +band.head() { + Eterm BandOp1, BandOp2; +} + +band.fetch(Src1, Src2) { + BandOp1 = $Src1; + BandOp2 = $Src2; +} + +band.execute(Fail, Live, Dst) { + if (is_both_small(BandOp1, BandOp2)) { + /* + * No need to untag -- TAG & TAG == TAG. + */ + $Dst = BandOp1 & BandOp2; + $NEXT0(); + } + $OUTLINED_ARITH_2($Fail, $Live, band, BIF_band_2, BandOp1, BandOp2, $Dst); +} + +i_bor(Fail, Live, Src1, Src2, Dst) { + if (is_both_small($Src1, $Src2)) { + /* + * No need to untag -- TAG | TAG == TAG. + */ + $Dst = $Src1 | $Src2; + $NEXT0(); + } + $OUTLINED_ARITH_2($Fail, $Live, bor, BIF_bor_2, $Src1, $Src2, $Dst); +} + +i_bxor(Fail, Live, Src1, Src2, Dst) { + if (is_both_small($Src1, $Src2)) { + /* + * TAG ^ TAG == 0. + * + * Therefore, we perform the XOR operation on the tagged values, + * and OR in the tag bits. + */ + $Dst = ($Src1 ^ $Src2) | make_small(0); + $NEXT0(); + } + $OUTLINED_ARITH_2($Fail, $Live, bxor, BIF_bxor_2, $Src1, $Src2, $Dst); +} + +i_bsl := shift.setup_bsl.execute; +i_bsr := shift.setup_bsr.execute; + +shift.head() { + Eterm Op1, Op2; + Sint shift_left_count; + Sint ires; + Eterm* bigp; + Eterm tmp_big[2]; + Uint BIF; +} + +shift.setup_bsr(Src1, Src2) { + Op1 = $Src1; + Op2 = $Src2; + BIF = BIF_bsr_2; + if (is_small(Op2)) { + shift_left_count = -signed_val(Op2); + } else if (is_big(Op2)) { + /* + * N bsr NegativeBigNum == N bsl MAX_SMALL + * N bsr PositiveBigNum == N bsl MIN_SMALL + */ + shift_left_count = make_small(bignum_header_is_neg(*big_val(Op2)) ? + MAX_SMALL : MIN_SMALL); + } else { + shift_left_count = 0; + } +} + +shift.setup_bsl(Src1, Src2) { + Op1 = $Src1; + Op2 = $Src2; + BIF = BIF_bsl_2; + if (is_small(Op2)) { + shift_left_count = signed_val(Op2); + } else if (is_big(Op2)) { + if (bignum_header_is_neg(*big_val(Op2))) { + /* + * N bsl NegativeBigNum is either 0 or -1, depending on + * the sign of N. Since we don't believe this case + * is common, do the calculation with the minimum + * amount of code. + */ + shift_left_count = MIN_SMALL; + } else if (is_integer(Op1)) { + /* + * N bsl PositiveBigNum is too large to represent. + */ + shift_left_count = MAX_SMALL; + } + } else { + shift_left_count = 0; + } +} + +shift.execute(Fail, Live, Dst) { + if (is_small(Op1)) { + ires = signed_val(Op1); + if (shift_left_count == 0 || ires == 0) { + if (is_not_integer(Op2)) { + c_p->freason = BADARITH; + $BIF_ERROR_ARITY_2($Fail, BIF, Op1, Op2); + } + if (ires == 0) { + $Dst = Op1; + $NEXT0(); + } + } else if (shift_left_count < 0) { /* Right shift */ + shift_left_count = -shift_left_count; + if (shift_left_count >= SMALL_BITS-1) { + $Dst = (ires < 0) ? SMALL_MINUS_ONE : SMALL_ZERO; + } else { + $Dst = make_small(ires >> shift_left_count); + } + $NEXT0(); + } else if (shift_left_count < SMALL_BITS-1) { /* Left shift */ + if ((ires > 0 && + ((~(Uint)0 << ((SMALL_BITS-1)-shift_left_count)) & + ires) == 0) || + ((~(Uint)0 << ((SMALL_BITS-1)-shift_left_count)) & + ~ires) == 0) { + $Dst = make_small(ires << shift_left_count); + $NEXT0(); + } + } + ires = 1; /* big_size(small_to_big(Op1)) */ + goto big_shift; + } else if (is_big(Op1)) { + if (shift_left_count == 0) { + if (is_not_integer(Op2)) { + c_p->freason = BADARITH; + $BIF_ERROR_ARITY_2($Fail, BIF, Op1, Op2); + } + $Dst = Op1; + $NEXT0(); + } + ires = big_size(Op1); + + big_shift: + if (shift_left_count > 0) { /* Left shift. */ + ires += (shift_left_count / D_EXP); + } else { /* Right shift. */ + if (ires <= (-shift_left_count / D_EXP)) { + ires = 3; /* ??? */ + } else { + ires -= (-shift_left_count / D_EXP); + } + } + { + ires = BIG_NEED_SIZE(ires+1); + + /* + * Slightly conservative check the size to avoid + * allocating huge amounts of memory for bignums that + * clearly would overflow the arity in the header + * word. + */ + if (ires-8 > BIG_ARITY_MAX) { + $SYSTEM_LIMIT($Fail); + } + $GC_TEST_PRESERVE(ires+1, $Live, Op1); + if (is_small(Op1)) { + Op1 = small_to_big(signed_val(Op1), tmp_big); + } + bigp = HTOP; + Op1 = big_lshift(Op1, shift_left_count, bigp); + if (is_big(Op1)) { + HTOP += bignum_header_arity(*HTOP) + 1; + } + HEAP_SPACE_VERIFIED(0); + if (is_nil(Op1)) { + /* + * This result must have been only slighty larger + * than allowed since it wasn't caught by the + * previous test. + */ + $SYSTEM_LIMIT($Fail); + } + ERTS_HOLE_CHECK(c_p); + $REFRESH_GEN_DEST(); + $Dst = Op1; + $NEXT0(); + } + } + + /* + * One or more non-integer arguments. + */ + c_p->freason = BADARITH; + $BIF_ERROR_ARITY_2($Fail, BIF, Op1, Op2); +} + +i_int_bnot(Fail, Src, Live, Dst) { + Eterm bnot_val = $Src; + if (is_small(bnot_val)) { + bnot_val = 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; + ERTS_HOLE_CHECK(c_p); + if (is_nil(bnot_val)) { + $BIF_ERROR_ARITY_1($Fail, BIF_bnot_1, reg[live]); + } + $REFRESH_GEN_DEST(); + } + $Dst = bnot_val; +} diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index a5a462944b..ff3c725bbc 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -62,17 +62,17 @@ #endif #ifdef ERTS_ENABLE_LOCK_CHECK -# define PROCESS_MAIN_CHK_LOCKS(P) \ -do { \ - if ((P)) \ - erts_proc_lc_chk_only_proc_main((P)); \ - ERTS_LC_ASSERT(!erts_thr_progress_is_blocking()); \ +# define PROCESS_MAIN_CHK_LOCKS(P) \ +do { \ + if ((P)) \ + erts_proc_lc_chk_only_proc_main((P)); \ + ERTS_LC_ASSERT(!erts_thr_progress_is_blocking()); \ } while (0) # define ERTS_REQ_PROC_MAIN_LOCK(P) \ -do { \ - if ((P)) \ - erts_proc_lc_require_lock((P), ERTS_PROC_LOCK_MAIN, \ - __FILE__, __LINE__); \ +do { \ + if ((P)) \ + erts_proc_lc_require_lock((P), ERTS_PROC_LOCK_MAIN, \ + __FILE__, __LINE__); \ } while (0) # define ERTS_UNREQ_PROC_MAIN_LOCK(P) \ do { \ @@ -156,63 +156,8 @@ do { \ #define REG_TARGET_PTR(Target) (((Target) & 1) ? &yb(Target-1) : &xb(Target)) #define REG_TARGET(Target) (*REG_TARGET_PTR(Target)) -/* - * Store a result into a register given a destination descriptor. - */ - -#define StoreResult(Result, DestDesc) \ - do { \ - Eterm stb_reg; \ - stb_reg = (DestDesc); \ - CHECK_TERM(Result); \ - REG_TARGET(stb_reg) = (Result); \ - } while (0) - -/* - * Store a result into a register and execute the next instruction. - * Dst points to the word with a destination descriptor, which MUST - * be just before the next instruction. - */ - -#define StoreBifResult(Dst, Result) \ - do { \ - BeamInstr* stb_next; \ - Eterm stb_reg; \ - stb_reg = Arg(Dst); \ - I += (Dst) + 2; \ - stb_next = (BeamInstr *) *I; \ - CHECK_TERM(Result); \ - REG_TARGET(stb_reg) = (Result); \ - Goto(stb_next); \ - } while (0) - -#define ClauseFail() goto jump_f - -#define SAVE_CP(X) \ - do { \ - *(X) = make_cp(c_p->cp); \ - c_p->cp = 0; \ - } while(0) - -#define RESTORE_CP(X) SET_CP(c_p, (BeamInstr *) cp_val(*(X))) - #define ISCATCHEND(instr) ((Eterm *) *(instr) == OpCode(catch_end_y)) -#define BIF_ERROR_ARITY_1(Op1, BIF) \ - if (Arg(0) != 0) goto jump_f; \ - reg[0] = Op1; \ - SWAPOUT; \ - I = handle_error(c_p, I, reg, &bif_export[BIF]->info.mfa); \ - goto post_error_handling - -#define BIF_ERROR_ARITY_2(Op1, Op2, BIF) \ - if (Arg(0) != 0) goto jump_f; \ - reg[0] = Op1; \ - reg[1] = Op2; \ - SWAPOUT; \ - I = handle_error(c_p, I, reg, &bif_export[BIF]->info.mfa); \ - goto post_error_handling - /* * Special Beam instructions. */ @@ -306,63 +251,6 @@ void** beam_ops; #define y(N) E[N] #define r(N) x(N) -#define TestBinVHeap(VNh, Nh, Live) \ - do { \ - unsigned need = (Nh); \ - if ((E - HTOP < need) || (MSO(c_p).overhead + (VNh) >= BIN_VHEAP_SZ(c_p))) {\ - SWAPOUT; \ - PROCESS_MAIN_CHK_LOCKS(c_p); \ - FCALLS -= erts_garbage_collect_nobump(c_p, need, reg, (Live), FCALLS); \ - ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); \ - PROCESS_MAIN_CHK_LOCKS(c_p); \ - SWAPIN; \ - } \ - HEAP_SPACE_VERIFIED(need); \ - } while (0) - - - -/* - * Check if Nh words of heap are available; if not, do a garbage collection. - * Live is number of active argument registers to be preserved. - */ - -#define TestHeap(Nh, Live) \ - do { \ - unsigned need = (Nh); \ - if (E - HTOP < need) { \ - SWAPOUT; \ - PROCESS_MAIN_CHK_LOCKS(c_p); \ - FCALLS -= erts_garbage_collect_nobump(c_p, need, reg, (Live), FCALLS); \ - ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); \ - PROCESS_MAIN_CHK_LOCKS(c_p); \ - SWAPIN; \ - } \ - HEAP_SPACE_VERIFIED(need); \ - } while (0) - -/* - * Check if Nh words of heap are available; if not, do a garbage collection. - * Live is number of active argument registers to be preserved. - * Takes special care to preserve Extra if a garbage collection occurs. - */ - -#define TestHeapPreserve(Nh, Live, Extra) \ - do { \ - unsigned need = (Nh); \ - if (E - HTOP < need) { \ - SWAPOUT; \ - reg[Live] = Extra; \ - PROCESS_MAIN_CHK_LOCKS(c_p); \ - FCALLS -= erts_garbage_collect_nobump(c_p, need, reg, (Live)+1, FCALLS); \ - ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); \ - PROCESS_MAIN_CHK_LOCKS(c_p); \ - Extra = reg[Live]; \ - SWAPIN; \ - } \ - HEAP_SPACE_VERIFIED(need); \ - } while (0) - /* * Check that we haven't used the reductions and jump to function pointed to by * the I register. If we are out of reductions, do a context switch. @@ -435,12 +323,6 @@ void** beam_ops; ASSERT(VALID_INSTR(*I)); \ Goto(*I) -#define PreFetch(N, Dst) do { Dst = (BeamInstr *) *(I + N + 1); } while (0) -#define NextPF(N, Dst) \ - I += N + 1; \ - ASSERT(VALID_INSTR(Dst)); \ - Goto(Dst) - #define GetR(pos, tr) \ do { \ tr = Arg(pos); \ @@ -456,13 +338,20 @@ void** beam_ops; CHECK_TERM(tr); \ } while (0) -#define GetArg1(N, Dst) GetR((N), Dst) - -#define GetArg2(N, Dst1, Dst2) \ - do { \ - GetR(N, Dst1); \ - GetR((N)+1, Dst2); \ - } while (0) +#define PUT_TERM_REG(term, desc) \ +do { \ + switch (loader_tag(desc)) { \ + case LOADER_X_REG: \ + x(loader_x_reg_index(desc)) = (term); \ + break; \ + case LOADER_Y_REG: \ + y(loader_y_reg_index(desc)) = (term); \ + break; \ + default: \ + ASSERT(0); \ + break; \ + } \ +} while(0) #define DispatchReturn \ do { \ @@ -485,51 +374,6 @@ do { \ # define BEAM_IS_TUPLE(Src) is_boxed(Src) #endif -#if defined(ARCH_64) -#define BsSafeMul(A, B, Fail, Target) \ - do { Uint64 _res = (A) * (B); \ - if (_res / B != A) { Fail; } \ - Target = _res; \ - } while (0) -#else -#define BsSafeMul(A, B, Fail, Target) \ - do { Uint64 _res = (Uint64)(A) * (Uint64)(B); \ - if ((_res >> (8*sizeof(Uint))) != 0) { Fail; } \ - Target = _res; \ - } while (0) -#endif - -#define BsGetFieldSize(Bits, Unit, Fail, Target) \ - do { \ - Sint _signed_size; Uint _uint_size; \ - Uint temp_bits; \ - if (is_small(Bits)) { \ - _signed_size = signed_val(Bits); \ - if (_signed_size < 0) { Fail; } \ - _uint_size = (Uint) _signed_size; \ - } else { \ - if (!term_to_Uint(Bits, &temp_bits)) { Fail; } \ - _uint_size = temp_bits; \ - } \ - BsSafeMul(_uint_size, Unit, Fail, Target); \ - } while (0) - -#define BsGetUncheckedFieldSize(Bits, Unit, Fail, Target) \ - do { \ - Sint _signed_size; Uint _uint_size; \ - Uint temp_bits; \ - if (is_small(Bits)) { \ - _signed_size = signed_val(Bits); \ - if (_signed_size < 0) { Fail; } \ - _uint_size = (Uint) _signed_size; \ - } else { \ - if (!term_to_Uint(Bits, &temp_bits)) { Fail; } \ - _uint_size = (Uint) temp_bits; \ - } \ - Target = _uint_size * Unit; \ - } while (0) - - /* * process_main() is already huge, so we want to avoid inlining * into it. Especially functions that are seldom used. @@ -718,6 +562,13 @@ init_emulator(void) #define ERTS_DBG_CHK_REDS(P, FC) #endif +#ifdef NO_FPE_SIGNALS +# define ERTS_NO_FPE_CHECK_INIT ERTS_FP_CHECK_INIT +# define ERTS_NO_FPE_ERROR ERTS_FP_ERROR +#else +# define ERTS_NO_FPE_CHECK_INIT(p) +# define ERTS_NO_FPE_ERROR(p, a, b) +#endif /* * process_main() is called twice: @@ -781,8 +632,6 @@ void process_main(Eterm * x_reg_array, FloatDef* f_reg_array) #endif #endif - Eterm pt_arity; /* Used by do_put_tuple */ - Uint64 start_time = 0; /* Monitor long schedule */ BeamInstr* start_time_i = NULL; @@ -923,1849 +772,9 @@ void process_main(Eterm * x_reg_array, FloatDef* f_reg_array) #ifdef NO_JUMP_TABLE switch (Go) { #endif -#include "beam_hot.h" - - { - Eterm increment_reg_val; - Eterm increment_val; - Uint live; - Eterm result; - - OpCase(i_increment_rIId): - increment_reg_val = x(0); - I--; - goto do_increment; - - OpCase(i_increment_xIId): - increment_reg_val = xb(Arg(0)); - goto do_increment; - - OpCase(i_increment_yIId): - increment_reg_val = yb(Arg(0)); - goto do_increment; - - do_increment: - increment_val = Arg(1); - if (is_small(increment_reg_val)) { - Sint i = signed_val(increment_reg_val) + increment_val; - ASSERT(MY_IS_SSMALL(i) == IS_SSMALL(i)); - if (MY_IS_SSMALL(i)) { - result = make_small(i); - StoreBifResult(3, result); - } - } - - live = Arg(2); - 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; - ERTS_HOLE_CHECK(c_p); - if (is_value(result)) { - StoreBifResult(3, result); - } - ASSERT(c_p->freason != BADMATCH || is_value(c_p->fvalue)); - goto find_func_info; - } - -#define DO_OUTLINED_ARITH_2(name, Op1, Op2, BIF)\ - do { \ - Eterm result; \ - Uint live = Arg(1); \ - \ - HEAVY_SWAPOUT; \ - reg[live] = Op1; \ - reg[live+1] = Op2; \ - result = erts_gc_##name(c_p, reg, live); \ - HEAVY_SWAPIN; \ - ERTS_HOLE_CHECK(c_p); \ - if (is_value(result)) { \ - StoreBifResult(4, result); \ - } \ - BIF_ERROR_ARITY_2(reg[live], reg[live+1], BIF);\ - } while (0) - - { - Eterm PlusOp1, PlusOp2; - Eterm result; - - OpCase(i_plus_jIxxd): - PlusOp1 = xb(Arg(2)); - PlusOp2 = xb(Arg(3)); - goto do_plus; - - OpCase(i_plus_jIxyd): - PlusOp1 = xb(Arg(2)); - PlusOp2 = yb(Arg(3)); - goto do_plus; - - OpCase(i_plus_jIssd): - GetArg2(2, PlusOp1, PlusOp2); - goto do_plus; - - do_plus: - if (is_both_small(PlusOp1, PlusOp2)) { - Sint i = signed_val(PlusOp1) + signed_val(PlusOp2); - ASSERT(MY_IS_SSMALL(i) == IS_SSMALL(i)); - if (MY_IS_SSMALL(i)) { - result = make_small(i); - StoreBifResult(4, result); - } - } - DO_OUTLINED_ARITH_2(mixed_plus, PlusOp1, PlusOp2, BIF_splus_2); - } - - { - Eterm MinusOp1, MinusOp2; - Eterm result; - - OpCase(i_minus_jIxxd): - MinusOp1 = xb(Arg(2)); - MinusOp2 = xb(Arg(3)); - goto do_minus; - - OpCase(i_minus_jIssd): - GetArg2(2, MinusOp1, MinusOp2); - goto do_minus; - - do_minus: - if (is_both_small(MinusOp1, MinusOp2)) { - Sint i = signed_val(MinusOp1) - signed_val(MinusOp2); - ASSERT(MY_IS_SSMALL(i) == IS_SSMALL(i)); - if (MY_IS_SSMALL(i)) { - result = make_small(i); - StoreBifResult(4, result); - } - } - DO_OUTLINED_ARITH_2(mixed_minus, MinusOp1, MinusOp2, BIF_sminus_2); - } - - { - Eterm is_eq_exact_lit_val; - - OpCase(i_is_eq_exact_literal_fxc): - is_eq_exact_lit_val = xb(Arg(1)); - goto do_is_eq_exact_literal; - - OpCase(i_is_eq_exact_literal_fyc): - is_eq_exact_lit_val = yb(Arg(1)); - goto do_is_eq_exact_literal; - - do_is_eq_exact_literal: - if (!eq(Arg(2), is_eq_exact_lit_val)) { - ClauseFail(); - } - Next(3); - } - - { - Eterm is_ne_exact_lit_val; - - OpCase(i_is_ne_exact_literal_fxc): - is_ne_exact_lit_val = xb(Arg(1)); - goto do_is_ne_exact_literal; - - OpCase(i_is_ne_exact_literal_fyc): - is_ne_exact_lit_val = yb(Arg(1)); - goto do_is_ne_exact_literal; - - do_is_ne_exact_literal: - if (eq(Arg(2), is_ne_exact_lit_val)) { - ClauseFail(); - } - Next(3); - } - - OpCase(i_move_call_ext_last_ePc): { - r(0) = Arg(2); - } - /* FALL THROUGH */ - OpCase(i_call_ext_last_eP): - RESTORE_CP(E); - E = ADD_BYTE_OFFSET(E, Arg(1)); - - /* - * Note: The pointer to the export entry is never NULL; if the module - * is not loaded, it points to code which will invoke the error handler - * (see lb_call_error_handler below). - */ - DTRACE_GLOBAL_CALL_FROM_EXPORT(c_p, Arg(0)); - Dispatchx(); - - OpCase(i_move_call_ext_ce): { - r(0) = Arg(0); - I++; - } - /* FALL THROUGH */ - OpCase(i_call_ext_e): - SET_CP(c_p, I+2); - DTRACE_GLOBAL_CALL_FROM_EXPORT(c_p, Arg(0)); - Dispatchx(); - - OpCase(i_move_call_ext_only_ec): { - r(0) = Arg(1); - } - /* FALL THROUGH */ - OpCase(i_call_ext_only_e): - DTRACE_GLOBAL_CALL_FROM_EXPORT(c_p, Arg(0)); - Dispatchx(); - - OpCase(return): { - SET_I(c_p->cp); - DTRACE_RETURN_FROM_PC(c_p); - /* - * We must clear the CP to make sure that a stale value do not - * create a false module dependcy preventing code upgrading. - * It also means that we can use the CP in stack backtraces. - */ - c_p->cp = 0; - CHECK_TERM(r(0)); - HEAP_SPACE_VERIFIED(0); - DispatchReturn; - } - - /* - * Send is almost a standard call-BIF with two arguments, except for: - * 1) It cannot be traced. - * 2) There is no pointer to the send_2 function stored in - * the instruction. - */ - - OpCase(send): { - BeamInstr *next; - Eterm result; - - if (!(FCALLS > 0 || FCALLS > neg_o_reds)) { - /* If we have run out of reductions, we do a context - switch before calling the bif */ - c_p->arity = 2; - c_p->current = NULL; - goto context_switch3; - } - - PRE_BIF_SWAPOUT(c_p); - c_p->fcalls = FCALLS - 1; - result = erl_send(c_p, r(0), x(1)); - PreFetch(0, next); - ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); - ERTS_REQ_PROC_MAIN_LOCK(c_p); - PROCESS_MAIN_CHK_LOCKS(c_p); - HTOP = HEAP_TOP(c_p); - FCALLS = c_p->fcalls; - if (is_value(result)) { - r(0) = result; - CHECK_TERM(r(0)); - NextPF(0, next); - } else if (c_p->freason == TRAP) { - SET_CP(c_p, I+1); - SET_I(c_p->i); - SWAPIN; - Dispatch(); - } - goto find_func_info; - } - - { - Eterm element_index; - Eterm element_tuple; - - OpCase(i_element_jxsd): - element_tuple = xb(Arg(1)); - goto do_element; - - OpCase(i_element_jysd): - element_tuple = yb(Arg(1)); - goto do_element; - - do_element: - GetArg1(2, element_index); - if (is_small(element_index) && is_tuple(element_tuple)) { - Eterm* tp = tuple_val(element_tuple); - - if ((signed_val(element_index) >= 1) && - (signed_val(element_index) <= arityval(*tp))) { - Eterm result = tp[signed_val(element_index)]; - StoreBifResult(3, result); - } - } - c_p->freason = BADARG; - BIF_ERROR_ARITY_2(element_index, element_tuple, BIF_element_2); - } - - OpCase(badarg_j): - badarg: - c_p->freason = BADARG; - goto lb_Cl_error; - - { - Eterm fast_element_tuple; - - OpCase(i_fast_element_jxId): - fast_element_tuple = xb(Arg(1)); - goto do_fast_element; - - OpCase(i_fast_element_jyId): - fast_element_tuple = yb(Arg(1)); - goto do_fast_element; - - do_fast_element: - if (is_tuple(fast_element_tuple)) { - Eterm* tp = tuple_val(fast_element_tuple); - Eterm pos = Arg(2); /* Untagged integer >= 1 */ - if (pos <= arityval(*tp)) { - Eterm result = tp[pos]; - StoreBifResult(3, result); - } - } - c_p->freason = BADARG; - BIF_ERROR_ARITY_2(make_small(Arg(2)), fast_element_tuple, BIF_element_2); - } - - OpCase(catch_yf): - c_p->catches++; - yb(Arg(0)) = Arg(1); - Next(2); - - OpCase(catch_end_y): { - c_p->catches--; - make_blank(yb(Arg(0))); - if (is_non_value(r(0))) { - c_p->fvalue = NIL; - if (x(1) == am_throw) { - r(0) = x(2); - } else { - if (x(1) == am_error) { - SWAPOUT; - x(2) = add_stacktrace(c_p, x(2), x(3)); - SWAPIN; - } - /* only x(2) is included in the rootset here */ - if (E - HTOP < 3) { - SWAPOUT; - PROCESS_MAIN_CHK_LOCKS(c_p); - FCALLS -= erts_garbage_collect_nobump(c_p, 3, reg+2, 1, FCALLS); - ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); - PROCESS_MAIN_CHK_LOCKS(c_p); - SWAPIN; - } - r(0) = TUPLE2(HTOP, am_EXIT, x(2)); - HTOP += 3; - } - } - CHECK_TERM(r(0)); - Next(1); - } - - OpCase(try_end_y): { - c_p->catches--; - make_blank(yb(Arg(0))); - if (is_non_value(r(0))) { - c_p->fvalue = NIL; - r(0) = x(1); - x(1) = x(2); - x(2) = x(3); - } - Next(1); - } - - /* - * Skeleton for receive statement: - * - * recv_mark L1 Optional - * call make_ref/monitor Optional - * ... - * recv_set L1 Optional - * L1: <-------------------+ - * <-----------+ | - * | | - * loop_rec L2 ------+---+ | - * ... | | | - * remove_message | | | - * jump L3 | | | - * ... | | | - * loop_rec_end L1 --+ | | - * L2: <---------------+ | - * wait L1 -----------------+ or wait_timeout - * timeout - * - * L3: Code after receive... - * - * - */ - - OpCase(recv_mark_f): { - /* - * Save the current position in message buffer and the - * the label for the loop_rec/2 instruction for the - * the receive statement. - */ - c_p->msg.mark = (BeamInstr *) Arg(0); - c_p->msg.saved_last = c_p->msg.last; - Next(1); - } - - OpCase(i_recv_set): { - /* - * If the mark is valid (points to the loop_rec/2 - * instruction that follows), we know that the saved - * position points to the first message that could - * possibly be matched out. - * - * If the mark is invalid, we do nothing, meaning that - * we will look through all messages in the message queue. - */ - if (c_p->msg.mark == (BeamInstr *) (I+1)) { - c_p->msg.save = c_p->msg.saved_last; - } - I++; - /* Fall through to the loop_rec/2 instruction */ - } - - /* - * Pick up the next message and place it in x(0). - * If no message, jump to a wait or wait_timeout instruction. - */ - OpCase(i_loop_rec_f): - { - BeamInstr *next; - ErtsMessage* msgp; - - /* - * We need to disable GC while matching messages - * in the queue. This since messages with data outside - * the heap will be corrupted by a GC. - */ - ASSERT(!(c_p->flags & F_DELAY_GC)); - c_p->flags |= F_DELAY_GC; - - loop_rec__: - - PROCESS_MAIN_CHK_LOCKS(c_p); - - msgp = PEEK_MESSAGE(c_p); - - if (!msgp) { - erts_proc_lock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); - /* Make sure messages wont pass exit signals... */ - if (ERTS_PROC_PENDING_EXIT(c_p)) { - erts_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); - SWAPOUT; - c_p->flags &= ~F_DELAY_GC; - c_p->arity = 0; - goto do_schedule; /* Will be rescheduled for exit */ - } - ERTS_MSGQ_MV_INQ2PRIVQ(c_p); - msgp = PEEK_MESSAGE(c_p); - if (msgp) - erts_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); - else - { - c_p->flags &= ~F_DELAY_GC; - SET_I((BeamInstr *) Arg(0)); - Goto(*I); /* Jump to a wait or wait_timeout instruction */ - } - } - if (is_non_value(ERL_MESSAGE_TERM(msgp))) { - SWAPOUT; /* erts_decode_dist_message() may write to heap... */ - if (!erts_decode_dist_message(c_p, ERTS_PROC_LOCK_MAIN, msgp, 0)) { - /* - * A corrupt distribution message that we weren't able to decode; - * remove it... - */ - /* No swapin should be needed */ - ASSERT(HTOP == c_p->htop && E == c_p->stop); - /* TODO: Add DTrace probe for this bad message situation? */ - UNLINK_MESSAGE(c_p, msgp); - msgp->next = NULL; - erts_cleanup_messages(msgp); - goto loop_rec__; - } - SWAPIN; - } - PreFetch(1, next); - r(0) = ERL_MESSAGE_TERM(msgp); - NextPF(1, next); - } - - /* - * Remove a (matched) message from the message queue. - */ - OpCase(remove_message): { - BeamInstr *next; - ErtsMessage* msgp; - PROCESS_MAIN_CHK_LOCKS(c_p); - - ERTS_CHK_MBUF_SZ(c_p); - - PreFetch(0, next); - msgp = PEEK_MESSAGE(c_p); - - if (ERTS_PROC_GET_SAVED_CALLS_BUF(c_p)) { - save_calls(c_p, &exp_receive); - } - if (ERL_MESSAGE_TOKEN(msgp) == NIL) { -#ifdef USE_VM_PROBES - if (DT_UTAG(c_p) != NIL) { - if (DT_UTAG_FLAGS(c_p) & DT_UTAG_PERMANENT) { - SEQ_TRACE_TOKEN(c_p) = am_have_dt_utag; - } else { - DT_UTAG(c_p) = NIL; - SEQ_TRACE_TOKEN(c_p) = NIL; - } - } else { -#endif - SEQ_TRACE_TOKEN(c_p) = NIL; -#ifdef USE_VM_PROBES - } - DT_UTAG_FLAGS(c_p) &= ~DT_UTAG_SPREADING; -#endif - } else if (ERL_MESSAGE_TOKEN(msgp) != am_undefined) { - Eterm msg; - SEQ_TRACE_TOKEN(c_p) = ERL_MESSAGE_TOKEN(msgp); -#ifdef USE_VM_PROBES - if (ERL_MESSAGE_TOKEN(msgp) == am_have_dt_utag) { - if (DT_UTAG(c_p) == NIL) { - DT_UTAG(c_p) = ERL_MESSAGE_DT_UTAG(msgp); - } - DT_UTAG_FLAGS(c_p) |= DT_UTAG_SPREADING; - } else { -#endif - ASSERT(is_tuple(SEQ_TRACE_TOKEN(c_p))); - ASSERT(SEQ_TRACE_TOKEN_ARITY(c_p) == 5); - ASSERT(is_small(SEQ_TRACE_TOKEN_SERIAL(c_p))); - ASSERT(is_small(SEQ_TRACE_TOKEN_LASTCNT(c_p))); - ASSERT(is_small(SEQ_TRACE_TOKEN_FLAGS(c_p))); - ASSERT(is_pid(SEQ_TRACE_TOKEN_SENDER(c_p))); - c_p->seq_trace_lastcnt = unsigned_val(SEQ_TRACE_TOKEN_SERIAL(c_p)); - if (c_p->seq_trace_clock < unsigned_val(SEQ_TRACE_TOKEN_SERIAL(c_p))) { - c_p->seq_trace_clock = unsigned_val(SEQ_TRACE_TOKEN_SERIAL(c_p)); - } - msg = ERL_MESSAGE_TERM(msgp); - seq_trace_output(SEQ_TRACE_TOKEN(c_p), msg, SEQ_TRACE_RECEIVE, - c_p->common.id, c_p); -#ifdef USE_VM_PROBES - } -#endif - } -#ifdef USE_VM_PROBES - if (DTRACE_ENABLED(message_receive)) { - Eterm token2 = NIL; - DTRACE_CHARBUF(receiver_name, DTRACE_TERM_BUF_SIZE); - Sint tok_label = 0; - Sint tok_lastcnt = 0; - Sint tok_serial = 0; - - dtrace_proc_str(c_p, receiver_name); - token2 = SEQ_TRACE_TOKEN(c_p); - if (have_seqtrace(token2)) { - tok_label = signed_val(SEQ_TRACE_T_LABEL(token2)); - tok_lastcnt = signed_val(SEQ_TRACE_T_LASTCNT(token2)); - tok_serial = signed_val(SEQ_TRACE_T_SERIAL(token2)); - } - DTRACE6(message_receive, - receiver_name, size_object(ERL_MESSAGE_TERM(msgp)), - c_p->msg.len - 1, tok_label, tok_lastcnt, tok_serial); - } -#endif - UNLINK_MESSAGE(c_p, msgp); - JOIN_MESSAGE(c_p); - CANCEL_TIMER(c_p); - - erts_save_message_in_proc(c_p, msgp); - c_p->flags &= ~F_DELAY_GC; - - if (ERTS_IS_GC_DESIRED_INTERNAL(c_p, HTOP, E)) { - /* - * We want to GC soon but we leave a few - * reductions giving the message some time - * to turn into garbage. - */ - ERTS_VBUMP_LEAVE_REDS_INTERNAL(c_p, 5, FCALLS); - } - - ERTS_DBG_CHK_REDS(c_p, FCALLS); - ERTS_CHK_MBUF_SZ(c_p); - - ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); - PROCESS_MAIN_CHK_LOCKS(c_p); - NextPF(0, next); - } - - /* - * Advance the save pointer to the next message (the current - * message didn't match), then jump to the loop_rec instruction. - */ - OpCase(loop_rec_end_f): { - - ASSERT(c_p->flags & F_DELAY_GC); - - SET_I((BeamInstr *) Arg(0)); - SAVE_MESSAGE(c_p); - if (FCALLS > 0 || FCALLS > neg_o_reds) { - FCALLS--; - goto loop_rec__; - } - - c_p->flags &= ~F_DELAY_GC; - c_p->i = I; - SWAPOUT; - c_p->arity = 0; - c_p->current = NULL; - goto do_schedule; - } - /* - * Prepare to wait for a message or a timeout, whichever occurs first. - * - * Note: In order to keep the compatibility between 32 and 64 bits - * emulators, only timeout values that can be represented in 32 bits - * (unsigned) or less are allowed. - */ - - - OpCase(i_wait_timeout_fs): { - erts_proc_lock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); - - /* Fall through */ - } - OpCase(i_wait_timeout_locked_fs): { - Eterm timeout_value; - - /* - * If we have already set the timer, we must NOT set it again. Therefore, - * we must test the F_INSLPQUEUE flag as well as the F_TIMO flag. - */ - if (c_p->flags & (F_INSLPQUEUE | F_TIMO)) { - goto wait2; - } - GetArg1(1, timeout_value); - if (timeout_value != make_small(0)) { - - if (timeout_value == am_infinity) - c_p->flags |= F_TIMO; - else { - int tres = erts_set_proc_timer_term(c_p, timeout_value); - if (tres == 0) { - /* - * The timer routiner will set c_p->i to the value in - * c_p->def_arg_reg[0]. Note that it is safe to use this - * location because there are no living x registers in - * a receive statement. - */ - BeamInstr** pi = (BeamInstr**) c_p->def_arg_reg; - *pi = I+3; - } - else { /* Wrong time */ - OpCase(i_wait_error_locked): { - erts_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); - /* Fall through */ - } - OpCase(i_wait_error): { - c_p->freason = EXC_TIMEOUT_VALUE; - goto find_func_info; - } - } - } - - /* - * Prepare to wait indefinitely for a new message to arrive - * (or the time set above if falling through from above). - * - * When a new message arrives, control will be transferred - * the loop_rec instruction (at label L1). In case of - * of timeout, control will be transferred to the timeout - * instruction following the wait_timeout instruction. - */ - - OpCase(wait_locked_f): - OpCase(wait_f): - - wait2: { - c_p->i = (BeamInstr *) Arg(0); /* L1 */ - SWAPOUT; - c_p->arity = 0; - - if (!ERTS_PTMR_IS_TIMED_OUT(c_p)) - erts_atomic32_read_band_relb(&c_p->state, - ~ERTS_PSFLG_ACTIVE); - ASSERT(!ERTS_PROC_IS_EXITING(c_p)); - erts_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); - c_p->current = NULL; - goto do_schedule; - } - OpCase(wait_unlocked_f): { - erts_proc_lock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); - goto wait2; - } - } - erts_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); - Next(2); - } - - OpCase(i_wait_timeout_fI): { - erts_proc_lock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); - } - - OpCase(i_wait_timeout_locked_fI): - { - /* - * If we have already set the timer, we must NOT set it again. Therefore, - * we must test the F_INSLPQUEUE flag as well as the F_TIMO flag. - */ - if ((c_p->flags & (F_INSLPQUEUE | F_TIMO)) == 0) { - BeamInstr** p = (BeamInstr **) c_p->def_arg_reg; - *p = I+3; - erts_set_proc_timer_uword(c_p, Arg(1)); - } - goto wait2; - } - - /* - * A timeout has occurred. Reset the save pointer so that the next - * receive statement will examine the first message first. - */ - OpCase(timeout_locked): { - erts_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); - } - OpCase(timeout): { - BeamInstr *next; - - PreFetch(0, next); - if (IS_TRACED_FL(c_p, F_TRACE_RECEIVE)) { - trace_receive(c_p, am_clock_service, am_timeout, NULL); - } - if (ERTS_PROC_GET_SAVED_CALLS_BUF(c_p)) { - save_calls(c_p, &exp_timeout); - } - c_p->flags &= ~F_TIMO; - JOIN_MESSAGE(c_p); - NextPF(0, next); - } - - { - Eterm select_val2; - - OpCase(i_select_tuple_arity2_yfAAff): - select_val2 = yb(Arg(0)); - goto do_select_tuple_arity2; - - OpCase(i_select_tuple_arity2_xfAAff): - select_val2 = xb(Arg(0)); - goto do_select_tuple_arity2; - - do_select_tuple_arity2: - if (is_not_tuple(select_val2)) { - goto select_val2_fail; - } - select_val2 = *tuple_val(select_val2); - goto do_select_val2; - - OpCase(i_select_val2_yfccff): - select_val2 = yb(Arg(0)); - goto do_select_val2; - - OpCase(i_select_val2_xfccff): - select_val2 = xb(Arg(0)); - goto do_select_val2; - - do_select_val2: - if (select_val2 == Arg(2)) { - I += 3; - } else if (select_val2 == Arg(3)) { - I += 4; - } - - select_val2_fail: - SET_I((BeamInstr *) Arg(1)); - Goto(*I); - } - - { - Eterm select_val; - - OpCase(i_select_tuple_arity_xfI): - select_val = xb(Arg(0)); - goto do_select_tuple_arity; - - OpCase(i_select_tuple_arity_yfI): - select_val = yb(Arg(0)); - goto do_select_tuple_arity; - - do_select_tuple_arity: - if (is_tuple(select_val)) { - select_val = *tuple_val(select_val); - goto do_linear_search; - } - SET_I((BeamInstr *) Arg(1)); - Goto(*I); - - OpCase(i_select_val_lins_xfI): - select_val = xb(Arg(0)); - goto do_linear_search; - - OpCase(i_select_val_lins_yfI): - select_val = yb(Arg(0)); - goto do_linear_search; - - do_linear_search: { - BeamInstr *vs = &Arg(3); - int ix = 0; - - for(;;) { - if (vs[ix+0] >= select_val) { ix += 0; break; } - if (vs[ix+1] >= select_val) { ix += 1; break; } - ix += 2; - } - - if (vs[ix] == select_val) { - I += ix + Arg(2) + 2; - } - - SET_I((BeamInstr *) Arg(1)); - Goto(*I); - } - - OpCase(i_select_val_bins_xfI): - select_val = xb(Arg(0)); - goto do_binary_search; - - OpCase(i_select_val_bins_yfI): - select_val = yb(Arg(0)); - goto do_binary_search; - - do_binary_search: - { - struct Pairs { - BeamInstr val; - BeamInstr* addr; - }; - struct Pairs* low; - struct Pairs* high; - struct Pairs* mid; - int bdiff; /* int not long because the arrays aren't that large */ - - low = (struct Pairs *) &Arg(3); - high = low + Arg(2); - - /* The pointer subtraction (high-low) below must produce - * a signed result, because high could be < low. That - * requires the compiler to insert quite a bit of code. - * - * However, high will be > low so the result will be - * positive. We can use that knowledge to optimise the - * entire sequence, from the initial comparison to the - * computation of mid. - * - * -- Mikael Pettersson, Acumem AB - * - * Original loop control code: - * - * while (low < high) { - * mid = low + (high-low) / 2; - * - */ - while ((bdiff = (int)((char*)high - (char*)low)) > 0) { - unsigned int boffset = ((unsigned int)bdiff >> 1) & ~(sizeof(struct Pairs)-1); - - mid = (struct Pairs*)((char*)low + boffset); - if (select_val < mid->val) { - high = mid; - } else if (select_val > mid->val) { - low = mid + 1; - } else { - SET_I(mid->addr); - Goto(*I); - } - } - SET_I((BeamInstr *) Arg(1)); - Goto(*I); - } - } - - { - Eterm jump_on_val_zero_index; - - OpCase(i_jump_on_val_zero_yfI): - jump_on_val_zero_index = yb(Arg(0)); - goto do_jump_on_val_zero_index; - - OpCase(i_jump_on_val_zero_xfI): - jump_on_val_zero_index = xb(Arg(0)); - goto do_jump_on_val_zero_index; - - do_jump_on_val_zero_index: - if (is_small(jump_on_val_zero_index)) { - jump_on_val_zero_index = signed_val(jump_on_val_zero_index); - if (jump_on_val_zero_index < Arg(2)) { - SET_I((BeamInstr *) (&Arg(3))[jump_on_val_zero_index]); - Goto(*I); - } - } - SET_I((BeamInstr *) Arg(1)); - Goto(*I); - } - - { - Eterm jump_on_val_index; - - - OpCase(i_jump_on_val_yfII): - jump_on_val_index = yb(Arg(0)); - goto do_jump_on_val_index; - - OpCase(i_jump_on_val_xfII): - jump_on_val_index = xb(Arg(0)); - goto do_jump_on_val_index; - - do_jump_on_val_index: - if (is_small(jump_on_val_index)) { - jump_on_val_index = (Uint) (signed_val(jump_on_val_index) - Arg(3)); - if (jump_on_val_index < Arg(2)) { - SET_I((BeamInstr *) (&Arg(4))[jump_on_val_index]); - Goto(*I); - } - } - SET_I((BeamInstr *) Arg(1)); - Goto(*I); - } - - do_put_tuple: { - Eterm* hp = HTOP; - - *hp++ = make_arityval(pt_arity); - - do { - Eterm term = *I++; - switch (loader_tag(term)) { - case LOADER_X_REG: - *hp++ = x(loader_x_reg_index(term)); - break; - case LOADER_Y_REG: - *hp++ = y(loader_y_reg_index(term)); - break; - default: - *hp++ = term; - break; - } - } while (--pt_arity != 0); - HTOP = hp; - Goto(*I); - } - - OpCase(new_map_dII): { - Eterm res; - - HEAVY_SWAPOUT; - res = new_map(c_p, reg, I-1); - HEAVY_SWAPIN; - StoreResult(res, Arg(0)); - Next(3+Arg(2)); - } - - OpCase(i_new_small_map_lit_dIq): { - Eterm res; - Uint n; - - HEAVY_SWAPOUT; - res = new_small_map_lit(c_p, reg, &n, I-1); - HEAVY_SWAPIN; - StoreResult(res, Arg(0)); - Next(3+n); - } - -#define PUT_TERM_REG(term, desc) \ -do { \ - switch (loader_tag(desc)) { \ - case LOADER_X_REG: \ - x(loader_x_reg_index(desc)) = (term); \ - break; \ - case LOADER_Y_REG: \ - y(loader_y_reg_index(desc)) = (term); \ - break; \ - default: \ - ASSERT(0); \ - break; \ - } \ -} while(0) - - OpCase(i_get_map_elements_fsI): { - Eterm map; - BeamInstr *fs; - Uint sz, n; - - GetArg1(1, map); - - /* this instruction assumes Arg1 is a map, - * i.e. that it follows a test is_map if needed. - */ - - n = (Uint)Arg(2) / 3; - fs = &Arg(3); /* pattern fields and target registers */ - - if (is_flatmap(map)) { - flatmap_t *mp; - Eterm *ks; - Eterm *vs; - - mp = (flatmap_t *)flatmap_val(map); - sz = flatmap_get_size(mp); - - if (sz == 0) { - ClauseFail(); - } - - ks = flatmap_get_keys(mp); - vs = flatmap_get_values(mp); - - while(sz) { - if (EQ((Eterm) fs[0], *ks)) { - PUT_TERM_REG(*vs, fs[1]); - n--; - fs += 3; - /* no more values to fetch, we are done */ - if (n == 0) { - I = fs; - Next(-1); - } - } - ks++, sz--, vs++; - } - - ClauseFail(); - } else { - const Eterm *v; - Uint32 hx; - ASSERT(is_hashmap(map)); - while(n--) { - hx = fs[2]; - ASSERT(hx == hashmap_make_hash((Eterm)fs[0])); - if ((v = erts_hashmap_get(hx, (Eterm)fs[0], map)) == NULL) { - ClauseFail(); - } - PUT_TERM_REG(*v, fs[1]); - fs += 3; - } - I = fs; - Next(-1); - } - } -#undef PUT_TERM_REG - - OpCase(update_map_assoc_jsdII): { - Eterm res; - Eterm map; - - GetArg1(1, map); - HEAVY_SWAPOUT; - res = update_map_assoc(c_p, reg, map, I); - HEAVY_SWAPIN; - if (is_value(res)) { - StoreResult(res, Arg(2)); - Next(5+Arg(4)); - } else { - /* - * This can only happen if the code was compiled - * with the compiler in OTP 17. - */ - c_p->freason = BADMAP; - c_p->fvalue = map; - goto lb_Cl_error; - } - } - - OpCase(update_map_exact_jsdII): { - Eterm res; - Eterm map; - - GetArg1(1, map); - HEAVY_SWAPOUT; - res = update_map_exact(c_p, reg, map, I); - HEAVY_SWAPIN; - if (is_value(res)) { - StoreResult(res, Arg(2)); - Next(5+Arg(4)); - } else { - goto lb_Cl_error; - } - } - - - /* - * All guards with zero arguments have special instructions: - * self/0 - * node/0 - * - * All other guard BIFs take one or two arguments. - */ - - /* - * Guard BIF in head. On failure, ignore the error and jump - * to the code for the next clause. We don't support tracing - * of guard BIFs. - */ - - OpCase(bif1_fbsd): - { - ErtsBifFunc bf; - Eterm tmp_reg[1]; - Eterm result; - - GetArg1(2, tmp_reg[0]); - bf = (BifFunction) Arg(1); - 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); - result = (*bf)(c_p, tmp_reg, I); - ERTS_CHK_MBUF_SZ(c_p); - ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result)); - ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); - PROCESS_MAIN_CHK_LOCKS(c_p); - ERTS_HOLE_CHECK(c_p); - FCALLS = c_p->fcalls; - ERTS_DBG_CHK_REDS(c_p, FCALLS); - if (is_value(result)) { - StoreBifResult(3, result); - } - SET_I((BeamInstr *) Arg(0)); - Goto(*I); - } - - /* - * Guard BIF in body. It can fail like any BIF. No trace support. - */ - - OpCase(bif1_body_bsd): - { - ErtsBifFunc bf; - - Eterm tmp_reg[1]; - Eterm result; - - GetArg1(1, tmp_reg[0]); - bf = (ErtsBifFunc) Arg(0); - 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); - result = (*bf)(c_p, tmp_reg, I); - ERTS_CHK_MBUF_SZ(c_p); - ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result)); - ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); - PROCESS_MAIN_CHK_LOCKS(c_p); - ERTS_HOLE_CHECK(c_p); - FCALLS = c_p->fcalls; - ERTS_DBG_CHK_REDS(c_p, FCALLS); - if (is_value(result)) { - StoreBifResult(2, result); - } - reg[0] = tmp_reg[0]; - SWAPOUT; - I = handle_error(c_p, I, reg, ubif2mfa((void *) bf)); - goto post_error_handling; - } - - OpCase(i_gc_bif1_jIsId): - { - typedef Eterm (*GcBifFunction)(Process*, Eterm*, Uint); - GcBifFunction bf; - Eterm result; - Uint live = (Uint) Arg(3); - - GetArg1(2, x(live)); - bf = (GcBifFunction) Arg(1); - 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 (is_value(result)) { - StoreBifResult(4, result); - } - if (Arg(0) != 0) { - SET_I((BeamInstr *) Arg(0)); - Goto(*I); - } - x(0) = x(live); - I = handle_error(c_p, I, reg, gcbif2mfa((void *) bf)); - goto post_error_handling; - } - - OpCase(i_gc_bif2_jIIssd): /* Note, one less parameter than the i_gc_bif1 - and i_gc_bif3 */ - { - typedef Eterm (*GcBifFunction)(Process*, Eterm*, Uint); - GcBifFunction bf; - Eterm result; - Uint live = (Uint) Arg(2); - - GetArg2(3, x(live), x(live+1)); - /* - * 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). - */ - live++; - bf = (GcBifFunction) Arg(1); - 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 (is_value(result)) { - StoreBifResult(5, result); - } - if (Arg(0) != 0) { - SET_I((BeamInstr *) Arg(0)); - Goto(*I); - } - live--; - x(0) = x(live); - x(1) = x(live+1); - I = handle_error(c_p, I, reg, gcbif2mfa((void *) bf)); - goto post_error_handling; - } - - OpCase(i_gc_bif3_jIIssd): - { - typedef Eterm (*GcBifFunction)(Process*, Eterm*, Uint); - GcBifFunction bf; - Eterm result; - Uint live = (Uint) Arg(2); - - x(live) = x(SCRATCH_X_REG); - GetArg2(3, x(live+1), x(live+2)); - /* - * 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). - */ - live += 2; - bf = (GcBifFunction) Arg(1); - 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 (is_value(result)) { - StoreBifResult(5, result); - } - if (Arg(0) != 0) { - SET_I((BeamInstr *) Arg(0)); - Goto(*I); - } - 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)); - goto post_error_handling; - } - - /* - * Guards bifs and, or, xor in guards. - */ - OpCase(i_bif2_fbssd): - { - Eterm tmp_reg[2]; - ErtsBifFunc bf; - Eterm result; - - GetArg2(2, tmp_reg[0], tmp_reg[1]); - bf = (ErtsBifFunc) Arg(1); - 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); - result = (*bf)(c_p, tmp_reg, I); - ERTS_CHK_MBUF_SZ(c_p); - ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result)); - ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); - PROCESS_MAIN_CHK_LOCKS(c_p); - ERTS_HOLE_CHECK(c_p); - FCALLS = c_p->fcalls; - ERTS_DBG_CHK_REDS(c_p, FCALLS); - if (is_value(result)) { - StoreBifResult(4, result); - } - SET_I((BeamInstr *) Arg(0)); - Goto(*I); - } - - /* - * Guards bifs and, or, xor, relational operators in body. - */ - OpCase(i_bif2_body_bssd): - { - Eterm tmp_reg[2]; - ErtsBifFunc bf; - Eterm result; - - GetArg2(1, tmp_reg[0], tmp_reg[1]); - bf = (ErtsBifFunc) Arg(0); - PROCESS_MAIN_CHK_LOCKS(c_p); - ASSERT(!ERTS_PROC_IS_EXITING(c_p)); - ERTS_CHK_MBUF_SZ(c_p); - result = (*bf)(c_p, tmp_reg, I); - ERTS_CHK_MBUF_SZ(c_p); - ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result)); - ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); - PROCESS_MAIN_CHK_LOCKS(c_p); - ERTS_HOLE_CHECK(c_p); - if (is_value(result)) { - ASSERT(!is_CP(result)); - StoreBifResult(3, result); - } - reg[0] = tmp_reg[0]; - reg[1] = tmp_reg[1]; - SWAPOUT; - I = handle_error(c_p, I, reg, ubif2mfa((void *) bf)); - goto post_error_handling; - } - - /* - * The most general BIF call. The BIF may build any amount of data - * on the heap. The result is always returned in r(0). - */ - OpCase(call_bif_e): - { - ErtsBifFunc bf; - Eterm result; - BeamInstr *next; - ErlHeapFragment *live_hf_end; - Export *export = (Export*)Arg(0); - - - if (!((FCALLS - 1) > 0 || (FCALLS-1) > neg_o_reds)) { - /* If we have run out of reductions, we do a context - switch before calling the bif */ - c_p->arity = GET_BIF_ARITY(export); - c_p->current = &export->info.mfa; - goto context_switch3; - } - - ERTS_MSACC_SET_BIF_STATE_CACHED_X( - GET_BIF_MODULE(export), GET_BIF_ADDRESS(export)); - - bf = GET_BIF_ADDRESS(export); - - PRE_BIF_SWAPOUT(c_p); - ERTS_DBG_CHK_REDS(c_p, FCALLS); - c_p->fcalls = FCALLS - 1; - if (FCALLS <= 0) { - save_calls(c_p, export); - } - PreFetch(1, next); - ASSERT(!ERTS_PROC_IS_EXITING(c_p)); - ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); - live_hf_end = c_p->mbuf; - ERTS_CHK_MBUF_SZ(c_p); - result = (*bf)(c_p, reg, I); - ERTS_CHK_MBUF_SZ(c_p); - ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result)); - ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); - ERTS_HOLE_CHECK(c_p); - ERTS_REQ_PROC_MAIN_LOCK(c_p); - if (ERTS_IS_GC_DESIRED(c_p)) { - Uint arity = GET_BIF_ARITY(export); - result = erts_gc_after_bif_call_lhf(c_p, live_hf_end, result, reg, arity); - E = c_p->stop; - } - PROCESS_MAIN_CHK_LOCKS(c_p); - HTOP = HEAP_TOP(c_p); - FCALLS = c_p->fcalls; - ERTS_DBG_CHK_REDS(c_p, FCALLS); - /* We have to update the cache if we are enabled in order - to make sure no book keeping is done after we disabled - msacc. We don't always do this as it is quite expensive. */ - if (ERTS_MSACC_IS_ENABLED_CACHED_X()) - ERTS_MSACC_UPDATE_CACHE_X(); - ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_EMULATOR); - if (is_value(result)) { - r(0) = result; - CHECK_TERM(r(0)); - NextPF(1, next); - } else if (c_p->freason == TRAP) { - SET_CP(c_p, I+2); - SET_I(c_p->i); - SWAPIN; - Dispatch(); - } - - /* - * Error handling. SWAPOUT is not needed because it was done above. - */ - ASSERT(c_p->stop == E); - I = handle_error(c_p, I, reg, &export->info.mfa); - goto post_error_handling; - } - - /* - * Arithmetic operations. - */ - - OpCase(i_times_jIssd): - { - Eterm Op1, Op2; - GetArg2(2, Op1, Op2); - DO_OUTLINED_ARITH_2(mixed_times, Op1, Op2, BIF_stimes_2); - } - - OpCase(i_m_div_jIssd): - { - Eterm Op1, Op2; - GetArg2(2, Op1, Op2); - DO_OUTLINED_ARITH_2(mixed_div, Op1, Op2, BIF_div_2); - } - - OpCase(i_int_div_jIssd): - { - Eterm Op1, Op2; - - GetArg2(2, Op1, Op2); - if (Op2 == SMALL_ZERO) { - c_p->freason = BADARITH; - BIF_ERROR_ARITY_2(Op1, Op2, BIF_intdiv_2); - } else if (is_both_small(Op1, Op2)) { - Sint ires = signed_val(Op1) / signed_val(Op2); - if (MY_IS_SSMALL(ires)) { - Eterm result = make_small(ires); - StoreBifResult(4, result); - } - } - DO_OUTLINED_ARITH_2(int_div, Op1, Op2, BIF_intdiv_2); - } - - { - Eterm RemOp1, RemOp2; - - OpCase(i_rem_jIxxd): - RemOp1 = xb(Arg(2)); - RemOp2 = xb(Arg(3)); - goto do_rem; - - OpCase(i_rem_jIssd): - GetArg2(2, RemOp1, RemOp2); - goto do_rem; - - do_rem: - if (RemOp2 == SMALL_ZERO) { - c_p->freason = BADARITH; - BIF_ERROR_ARITY_2(RemOp1, RemOp2, BIF_rem_2); - } else if (is_both_small(RemOp1, RemOp2)) { - Eterm result = make_small(signed_val(RemOp1) % signed_val(RemOp2)); - StoreBifResult(4, result); - } else { - DO_OUTLINED_ARITH_2(int_rem, RemOp1, RemOp2, BIF_rem_2); - } - } - - { - Eterm BandOp1, BandOp2; - - OpCase(i_band_jIxcd): - BandOp1 = xb(Arg(2)); - BandOp2 = Arg(3); - goto do_band; - - OpCase(i_band_jIssd): - GetArg2(2, BandOp1, BandOp2); - goto do_band; - - do_band: - if (is_both_small(BandOp1, BandOp2)) { - /* - * No need to untag -- TAG & TAG == TAG. - */ - Eterm result = BandOp1 & BandOp2; - StoreBifResult(4, result); - } - DO_OUTLINED_ARITH_2(band, BandOp1, BandOp2, BIF_band_2); - } - - /* - * An error occurred in an arithmetic operation or test that could - * appear either in a head or in a body. - * In a head, execution should continue at failure address in Arg(0). - * In a body, Arg(0) == 0 and an exception should be raised. - */ - lb_Cl_error: { - if (Arg(0) != 0) { - OpCase(jump_f): { - jump_f: - SET_I((BeamInstr *) Arg(0)); - Goto(*I); - } - } - ASSERT(c_p->freason != BADMATCH || is_value(c_p->fvalue)); - goto find_func_info; - } - - OpCase(i_bor_jIssd): - { - Eterm Op1, Op2; - - GetArg2(2, Op1, Op2); - if (is_both_small(Op1, Op2)) { - /* - * No need to untag -- TAG | TAG == TAG. - */ - Eterm result = Op1 | Op2; - StoreBifResult(4, result); - } - DO_OUTLINED_ARITH_2(bor, Op1, Op2, BIF_bor_2); - } - - OpCase(i_bxor_jIssd): - { - Eterm Op1, Op2; - - GetArg2(2, Op1, Op2); - if (is_both_small(Op1, Op2)) { - /* - * TAG ^ TAG == 0. - * - * Therefore, we perform the XOR operation on the tagged values, - * and OR in the tag bits. - */ - Eterm result = (Op1 ^ Op2) | make_small(0); - StoreBifResult(4, result); - } - DO_OUTLINED_ARITH_2(bxor, Op1, Op2, BIF_bxor_2); - } - - { - Eterm Op1, Op2; - Sint i; - Sint ires; - Eterm* bigp; - Eterm tmp_big[2]; - - OpCase(i_bsr_jIssd): - GetArg2(2, Op1, Op2); - if (is_small(Op2)) { - i = -signed_val(Op2); - if (is_small(Op1)) { - goto small_shift; - } else if (is_big(Op1)) { - if (i == 0) { - StoreBifResult(4, Op1); - } - ires = big_size(Op1); - goto big_shift; - } - } else if (is_big(Op2)) { - /* - * N bsr NegativeBigNum == N bsl MAX_SMALL - * N bsr PositiveBigNum == N bsl MIN_SMALL - */ - Op2 = make_small(bignum_header_is_neg(*big_val(Op2)) ? - MAX_SMALL : MIN_SMALL); - goto do_bsl; - } - c_p->freason = BADARITH; - BIF_ERROR_ARITY_2(Op1, Op2, BIF_bsr_2); - - OpCase(i_bsl_jIssd): - GetArg2(2, Op1, Op2); - do_bsl: - if (is_small(Op2)) { - i = signed_val(Op2); - - if (is_small(Op1)) { - small_shift: - ires = signed_val(Op1); - - if (i == 0 || ires == 0) { - StoreBifResult(4, Op1); - } else if (i < 0) { /* Right shift */ - i = -i; - if (i >= SMALL_BITS-1) { - Op1 = (ires < 0) ? SMALL_MINUS_ONE : SMALL_ZERO; - } else { - Op1 = make_small(ires >> i); - } - StoreBifResult(4, Op1); - } else if (i < SMALL_BITS-1) { /* Left shift */ - if ((ires > 0 && ((~(Uint)0 << ((SMALL_BITS-1)-i)) & ires) == 0) || - ((~(Uint)0 << ((SMALL_BITS-1)-i)) & ~ires) == 0) { - Op1 = make_small(ires << i); - StoreBifResult(4, Op1); - } - } - ires = 1; /* big_size(small_to_big(Op1)) */ - - big_shift: - if (i > 0) { /* Left shift. */ - ires += (i / D_EXP); - } else { /* Right shift. */ - if (ires <= (-i / D_EXP)) - ires = 3; /* ??? */ - else - ires -= (-i / D_EXP); - } - { - ires = BIG_NEED_SIZE(ires+1); - /* - * Slightly conservative check the size to avoid - * allocating huge amounts of memory for bignums that - * clearly would overflow the arity in the header - * word. - */ - if (ires-8 > BIG_ARITY_MAX) { - c_p->freason = SYSTEM_LIMIT; - goto lb_Cl_error; - } - TestHeapPreserve(ires+1, Arg(1), Op1); - if (is_small(Op1)) { - Op1 = small_to_big(signed_val(Op1), tmp_big); - } - bigp = HTOP; - Op1 = big_lshift(Op1, i, bigp); - if (is_big(Op1)) { - HTOP += bignum_header_arity(*HTOP) + 1; - } - HEAP_SPACE_VERIFIED(0); - if (is_nil(Op1)) { - /* - * This result must have been only slight larger - * than allowed since it wasn't caught by the - * previous test. - */ - c_p->freason = SYSTEM_LIMIT; - goto lb_Cl_error; - } - ERTS_HOLE_CHECK(c_p); - StoreBifResult(4, Op1); - } - } else if (is_big(Op1)) { - if (i == 0) { - StoreBifResult(4, Op1); - } - ires = big_size(Op1); - goto big_shift; - } - } else if (is_big(Op2)) { - if (bignum_header_is_neg(*big_val(Op2))) { - /* - * N bsl NegativeBigNum is either 0 or -1, depending on - * the sign of N. Since we don't believe this case - * is common, do the calculation with the minimum - * amount of code. - */ - Op2 = make_small(MIN_SMALL); - goto do_bsl; - } else if (is_small(Op1) || is_big(Op1)) { - /* - * N bsl PositiveBigNum is too large to represent. - */ - c_p->freason = SYSTEM_LIMIT; - goto lb_Cl_error; - } - /* Fall through if the left argument is not an integer. */ - } - c_p->freason = BADARITH; - BIF_ERROR_ARITY_2(Op1, Op2, BIF_bsl_2); - } - - OpCase(i_int_bnot_jsId): - { - Eterm bnot_val; - - GetArg1(1, bnot_val); - if (is_small(bnot_val)) { - bnot_val = make_small(~signed_val(bnot_val)); - } else { - Uint live = Arg(2); - HEAVY_SWAPOUT; - reg[live] = bnot_val; - bnot_val = erts_gc_bnot(c_p, reg, live); - HEAVY_SWAPIN; - ERTS_HOLE_CHECK(c_p); - if (is_nil(bnot_val)) { - BIF_ERROR_ARITY_1(reg[live], BIF_bnot_1); - } - } - StoreBifResult(3, bnot_val); - } - - OpCase(i_apply): { - BeamInstr *next; - HEAVY_SWAPOUT; - next = apply(c_p, r(0), x(1), x(2), reg, NULL, 0); - HEAVY_SWAPIN; - if (next != NULL) { - SET_CP(c_p, I+1); - SET_I(next); - Dispatch(); - } - I = handle_error(c_p, I, reg, &bif_export[BIF_apply_3]->info.mfa); - goto post_error_handling; - } - - OpCase(i_apply_last_P): { - BeamInstr *next; - HEAVY_SWAPOUT; - next = apply(c_p, r(0), x(1), x(2), reg, I, Arg(0)); - HEAVY_SWAPIN; - if (next != NULL) { - SET_CP(c_p, (BeamInstr *) E[0]); - E = ADD_BYTE_OFFSET(E, Arg(0)); - SET_I(next); - Dispatch(); - } - I = handle_error(c_p, I, reg, &bif_export[BIF_apply_3]->info.mfa); - goto post_error_handling; - } - - OpCase(i_apply_only): { - BeamInstr *next; - HEAVY_SWAPOUT; - next = apply(c_p, r(0), x(1), x(2), reg, I, 0); - HEAVY_SWAPIN; - if (next != NULL) { - SET_I(next); - Dispatch(); - } - I = handle_error(c_p, I, reg, &bif_export[BIF_apply_3]->info.mfa); - goto post_error_handling; - } - - OpCase(apply_I): { - BeamInstr *next; - - HEAVY_SWAPOUT; - next = fixed_apply(c_p, reg, Arg(0), NULL, 0); - HEAVY_SWAPIN; - if (next != NULL) { - SET_CP(c_p, I+2); - SET_I(next); - Dispatch(); - } - I = handle_error(c_p, I, reg, &bif_export[BIF_apply_3]->info.mfa); - goto post_error_handling; - } - - OpCase(apply_last_IP): { - BeamInstr *next; - - HEAVY_SWAPOUT; - next = fixed_apply(c_p, reg, Arg(0), I, Arg(1)); - HEAVY_SWAPIN; - if (next != NULL) { - SET_CP(c_p, (BeamInstr *) E[0]); - E = ADD_BYTE_OFFSET(E, Arg(1)); - SET_I(next); - Dispatch(); - } - I = handle_error(c_p, I, reg, &bif_export[BIF_apply_3]->info.mfa); - goto post_error_handling; - } - - OpCase(i_apply_fun): { - BeamInstr *next; - - HEAVY_SWAPOUT; - next = apply_fun(c_p, r(0), x(1), reg); - HEAVY_SWAPIN; - if (next != NULL) { - SET_CP(c_p, I+1); - SET_I(next); - Dispatchfun(); - } - goto find_func_info; - } - - OpCase(i_apply_fun_last_P): { - BeamInstr *next; - - HEAVY_SWAPOUT; - next = apply_fun(c_p, r(0), x(1), reg); - HEAVY_SWAPIN; - if (next != NULL) { - SET_CP(c_p, (BeamInstr *) E[0]); - E = ADD_BYTE_OFFSET(E, Arg(0)); - SET_I(next); - Dispatchfun(); - } - goto find_func_info; - } - - OpCase(i_apply_fun_only): { - BeamInstr *next; - - HEAVY_SWAPOUT; - next = apply_fun(c_p, r(0), x(1), reg); - HEAVY_SWAPIN; - if (next != NULL) { - SET_I(next); - Dispatchfun(); - } - goto find_func_info; - } - - OpCase(i_call_fun_I): { - BeamInstr *next; - - HEAVY_SWAPOUT; - next = call_fun(c_p, Arg(0), reg, THE_NON_VALUE); - HEAVY_SWAPIN; - if (next != NULL) { - SET_CP(c_p, I+2); - SET_I(next); - Dispatchfun(); - } - goto find_func_info; - } - - OpCase(i_call_fun_last_IP): { - BeamInstr *next; - - HEAVY_SWAPOUT; - next = call_fun(c_p, Arg(0), reg, THE_NON_VALUE); - HEAVY_SWAPIN; - if (next != NULL) { - SET_CP(c_p, (BeamInstr *) E[0]); - E = ADD_BYTE_OFFSET(E, Arg(1)); - SET_I(next); - Dispatchfun(); - } - goto find_func_info; - } +#include "beam_hot.h" +#include "beam_instrs.h" #ifdef DEBUG /* @@ -2869,7 +878,7 @@ do { \ OpCase(normal_exit): { SWAPOUT; c_p->freason = EXC_NORMAL; - c_p->arity = 0; /* In case this process will never be garbed again. */ + c_p->arity = 0; /* In case this process will ever be garbed again. */ ERTS_UNREQ_PROC_MAIN_LOCK(c_p); erts_do_exit_process(c_p, am_normal); ERTS_REQ_PROC_MAIN_LOCK(c_p); @@ -2883,32 +892,6 @@ do { \ goto do_schedule; } - OpCase(i_raise): { - Eterm raise_trace = x(2); - Eterm raise_value = x(1); - struct StackTrace *s; - - c_p->fvalue = raise_value; - c_p->ftrace = raise_trace; - s = get_trace_from_exc(raise_trace); - if (s == NULL) { - c_p->freason = EXC_ERROR; - } else { - c_p->freason = PRIMARY_EXCEPTION(s->freason); - } - goto find_func_info; - } - - { - Eterm badmatch_val; - - OpCase(badmatch_x): - badmatch_val = xb(Arg(0)); - c_p->fvalue = badmatch_val; - c_p->freason = BADMATCH; - } - /* Fall through here */ - find_func_info: { SWAPOUT; I = handle_error(c_p, I, reg, NULL); @@ -2949,172 +932,6 @@ do { \ } } - { - Eterm nif_bif_result; - Eterm bif_nif_arity; - - OpCase(call_nif): - { - /* - * call_nif is always first instruction in function: - * - * I[-3]: Module - * I[-2]: Function - * I[-1]: Arity - * I[0]: &&call_nif - * I[1]: Function pointer to NIF function - * I[2]: Pointer to erl_module_nif - * I[3]: Function pointer to dirty NIF - * - * This layout is determined by the NifExport struct - */ - BifFunction vbf; - ErlHeapFragment *live_hf_end; - ErtsCodeMFA *codemfa; - - ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_NIF); - - codemfa = erts_code_to_codemfa(I); - - c_p->current = codemfa; /* current and vbf set to please handle_error */ - - DTRACE_NIF_ENTRY(c_p, codemfa); - - HEAVY_SWAPOUT; - - PROCESS_MAIN_CHK_LOCKS(c_p); - bif_nif_arity = codemfa->arity; - ERTS_UNREQ_PROC_MAIN_LOCK(c_p); - - ASSERT(!ERTS_PROC_IS_EXITING(c_p)); - { - typedef Eterm NifF(struct enif_environment_t*, int argc, Eterm argv[]); - NifF* fp = vbf = (NifF*) I[1]; - struct enif_environment_t env; - ASSERT(c_p->scheduler_data); - live_hf_end = c_p->mbuf; - ERTS_CHK_MBUF_SZ(c_p); - erts_pre_nif(&env, c_p, (struct erl_module_nif*)I[2], NULL); - nif_bif_result = (*fp)(&env, bif_nif_arity, reg); - if (env.exception_thrown) - nif_bif_result = THE_NON_VALUE; - erts_post_nif(&env); - ERTS_CHK_MBUF_SZ(c_p); - - PROCESS_MAIN_CHK_LOCKS(c_p); - ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); - ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_EMULATOR); - ASSERT(!env.exiting); - ASSERT(!ERTS_PROC_IS_EXITING(c_p)); - } - - DTRACE_NIF_RETURN(c_p, codemfa); - goto apply_bif_or_nif_epilogue; - - OpCase(apply_bif): - /* - * At this point, I points to the code[0] in the export entry for - * the BIF: - * - * code[-3]: Module - * code[-2]: Function - * code[-1]: Arity - * code[0]: &&apply_bif - * code[1]: Function pointer to BIF function - */ - - if (!((FCALLS - 1) > 0 || (FCALLS - 1) > neg_o_reds)) { - /* If we have run out of reductions, we do a context - switch before calling the bif */ - goto context_switch; - } - - codemfa = erts_code_to_codemfa(I); - - ERTS_MSACC_SET_BIF_STATE_CACHED_X(codemfa->module, (BifFunction)Arg(0)); - - - /* In case we apply process_info/1,2 or load_nif/1 */ - c_p->current = codemfa; - c_p->i = I; /* In case we apply check_process_code/2. */ - c_p->arity = 0; /* To allow garbage collection on ourselves - * (check_process_code/2). - */ - DTRACE_BIF_ENTRY(c_p, codemfa); - - SWAPOUT; - ERTS_DBG_CHK_REDS(c_p, FCALLS - 1); - c_p->fcalls = FCALLS - 1; - vbf = (BifFunction) Arg(0); - PROCESS_MAIN_CHK_LOCKS(c_p); - bif_nif_arity = codemfa->arity; - ASSERT(bif_nif_arity <= 4); - ERTS_UNREQ_PROC_MAIN_LOCK(c_p); - ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); - { - ErtsBifFunc bf = vbf; - ASSERT(!ERTS_PROC_IS_EXITING(c_p)); - live_hf_end = c_p->mbuf; - ERTS_CHK_MBUF_SZ(c_p); - nif_bif_result = (*bf)(c_p, reg, I); - ERTS_CHK_MBUF_SZ(c_p); - ASSERT(!ERTS_PROC_IS_EXITING(c_p) || - is_non_value(nif_bif_result)); - ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); - PROCESS_MAIN_CHK_LOCKS(c_p); - } - /* We have to update the cache if we are enabled in order - to make sure no book keeping is done after we disabled - msacc. We don't always do this as it is quite expensive. */ - if (ERTS_MSACC_IS_ENABLED_CACHED_X()) - ERTS_MSACC_UPDATE_CACHE_X(); - ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_EMULATOR); - DTRACE_BIF_RETURN(c_p, codemfa); - - apply_bif_or_nif_epilogue: - ERTS_REQ_PROC_MAIN_LOCK(c_p); - ERTS_HOLE_CHECK(c_p); - if (ERTS_IS_GC_DESIRED(c_p)) { - nif_bif_result = erts_gc_after_bif_call_lhf(c_p, live_hf_end, - nif_bif_result, - reg, bif_nif_arity); - } - SWAPIN; /* There might have been a garbage collection. */ - FCALLS = c_p->fcalls; - ERTS_DBG_CHK_REDS(c_p, FCALLS); - if (is_value(nif_bif_result)) { - r(0) = nif_bif_result; - CHECK_TERM(r(0)); - SET_I(c_p->cp); - c_p->cp = 0; - Goto(*I); - } else if (c_p->freason == TRAP) { - SET_I(c_p->i); - if (c_p->flags & F_HIBERNATE_SCHED) { - c_p->flags &= ~F_HIBERNATE_SCHED; - goto do_schedule; - } - Dispatch(); - } - I = handle_error(c_p, c_p->cp, reg, c_p->current); - goto post_error_handling; - } - } - - { - Eterm case_end_val; - - OpCase(case_end_x): - case_end_val = xb(Arg(0)); - c_p->fvalue = case_end_val; - c_p->freason = EXC_CASE_CLAUSE; - goto find_func_info; - } - - OpCase(if_end): - c_p->freason = EXC_IF_CLAUSE; - goto find_func_info; - OpCase(i_func_info_IaaI): { ErtsCodeInfo *ci = (ErtsCodeInfo*)I; c_p->freason = EXC_FUNCTION_CLAUSE; @@ -3122,1368 +939,8 @@ do { \ goto handle_error; } - OpCase(try_case_end_s): - { - Eterm try_case_end_val; - GetArg1(0, try_case_end_val); - c_p->fvalue = try_case_end_val; - c_p->freason = EXC_TRY_CLAUSE; - goto find_func_info; - } - - /* - * Construction of binaries using new instructions. - */ - { - Eterm new_binary; - Eterm num_bits_term; - Uint num_bits; - Uint alloc; - Uint num_bytes; - - OpCase(i_bs_init_bits_heap_IIIx): { - num_bits = Arg(0); - alloc = Arg(1); - I++; - goto do_bs_init_bits_known; - } - - OpCase(i_bs_init_bits_IIx): { - num_bits = Arg(0); - alloc = 0; - goto do_bs_init_bits_known; - } - - OpCase(i_bs_init_bits_fail_heap_sIjIx): { - GetArg1(0, num_bits_term); - alloc = Arg(1); - I += 2; - goto do_bs_init_bits; - } - - OpCase(i_bs_init_bits_fail_yjIx): { - num_bits_term = yb(Arg(0)); - I++; - alloc = 0; - goto do_bs_init_bits; - } - OpCase(i_bs_init_bits_fail_xjIx): { - num_bits_term = xb(Arg(0)); - I++; - alloc = 0; - /* FALL THROUGH */ - } - - /* num_bits_term = Term for number of bits to build (small/big) - * alloc = Number of words to allocate on heap - * Operands: Fail Live Dst - */ - - do_bs_init_bits: - if (is_small(num_bits_term)) { - Sint size = signed_val(num_bits_term); - if (size < 0) { - goto badarg; - } - num_bits = (Uint) size; - } else { - Uint bits; - - if (!term_to_Uint(num_bits_term, &bits)) { - c_p->freason = bits; - goto lb_Cl_error; - - } - num_bits = (Eterm) bits; - } - - /* num_bits = Number of bits to build - * alloc = Number of extra words to allocate on heap - * Operands: NotUsed Live Dst - */ - do_bs_init_bits_known: - num_bytes = ((Uint64)num_bits+(Uint64)7) >> 3; - if (num_bits & 7) { - alloc += ERL_SUB_BIN_SIZE; - } - if (num_bytes <= ERL_ONHEAP_BIN_LIMIT) { - alloc += heap_bin_size(num_bytes); - } else { - alloc += PROC_BIN_SIZE; - } - TestHeap(alloc, Arg(1)); - - /* num_bits = Number of bits to build - * num_bytes = Number of bytes to allocate in the binary - * alloc = Total number of words to allocate on heap - * Operands: NotUsed NotUsed Dst - */ - if (num_bytes <= ERL_ONHEAP_BIN_LIMIT) { - ErlHeapBin* hb; - - erts_bin_offset = 0; - erts_writable_bin = 0; - hb = (ErlHeapBin *) HTOP; - HTOP += heap_bin_size(num_bytes); - hb->thing_word = header_heap_bin(num_bytes); - hb->size = num_bytes; - erts_current_bin = (byte *) hb->data; - new_binary = make_binary(hb); - - do_bits_sub_bin: - if (num_bits & 7) { - ErlSubBin* sb; - - sb = (ErlSubBin *) HTOP; - HTOP += ERL_SUB_BIN_SIZE; - sb->thing_word = HEADER_SUB_BIN; - sb->size = num_bytes - 1; - sb->bitsize = num_bits & 7; - sb->offs = 0; - sb->bitoffs = 0; - sb->is_writable = 0; - sb->orig = new_binary; - new_binary = make_binary(sb); - } - HEAP_SPACE_VERIFIED(0); - xb(Arg(2)) = new_binary; - Next(3); - } else { - Binary* bptr; - ProcBin* pb; - - erts_bin_offset = 0; - erts_writable_bin = 0; - - /* - * Allocate the binary struct itself. - */ - bptr = erts_bin_nrml_alloc(num_bytes); - erts_current_bin = (byte *) bptr->orig_bytes; - - /* - * Now allocate the ProcBin on the heap. - */ - pb = (ProcBin *) HTOP; - HTOP += PROC_BIN_SIZE; - pb->thing_word = HEADER_PROC_BIN; - pb->size = num_bytes; - pb->next = MSO(c_p).first; - MSO(c_p).first = (struct erl_off_heap_header*) pb; - pb->val = bptr; - pb->bytes = (byte*) bptr->orig_bytes; - pb->flags = 0; - OH_OVERHEAD(&(MSO(c_p)), pb->size / sizeof(Eterm)); - new_binary = make_binary(pb); - goto do_bits_sub_bin; - } - } - - { - Eterm BsOp1, BsOp2; - - OpCase(i_bs_init_fail_heap_sIjIx): { - GetArg1(0, BsOp1); - BsOp2 = Arg(1); - I += 2; - goto do_bs_init; - } - - OpCase(i_bs_init_fail_yjIx): { - BsOp1 = yb(Arg(0)); - BsOp2 = 0; - I++; - goto do_bs_init; - } - - OpCase(i_bs_init_fail_xjIx): { - BsOp1 = xb(Arg(0)); - BsOp2 = 0; - I++; - } - /* FALL THROUGH */ - do_bs_init: - if (is_small(BsOp1)) { - Sint size = signed_val(BsOp1); - if (size < 0) { - goto badarg; - } - BsOp1 = (Eterm) size; - } else { - Uint bytes; - - if (!term_to_Uint(BsOp1, &bytes)) { - c_p->freason = bytes; - goto lb_Cl_error; - } - if ((bytes >> (8*sizeof(Uint)-3)) != 0) { - goto system_limit; - } - BsOp1 = (Eterm) bytes; - } - if (BsOp1 <= ERL_ONHEAP_BIN_LIMIT) { - goto do_heap_bin_alloc; - } else { - goto do_proc_bin_alloc; - } - - - OpCase(i_bs_init_heap_IIIx): { - BsOp1 = Arg(0); - BsOp2 = Arg(1); - I++; - goto do_proc_bin_alloc; - } - - OpCase(i_bs_init_IIx): { - BsOp1 = Arg(0); - BsOp2 = 0; - } - /* FALL THROUGH */ - do_proc_bin_alloc: { - Binary* bptr; - ProcBin* pb; - - erts_bin_offset = 0; - erts_writable_bin = 0; - TestBinVHeap(BsOp1 / sizeof(Eterm), - BsOp2 + PROC_BIN_SIZE + ERL_SUB_BIN_SIZE, Arg(1)); - - /* - * Allocate the binary struct itself. - */ - bptr = erts_bin_nrml_alloc(BsOp1); - erts_current_bin = (byte *) bptr->orig_bytes; - - /* - * Now allocate the ProcBin on the heap. - */ - pb = (ProcBin *) HTOP; - HTOP += PROC_BIN_SIZE; - pb->thing_word = HEADER_PROC_BIN; - pb->size = BsOp1; - pb->next = MSO(c_p).first; - MSO(c_p).first = (struct erl_off_heap_header*) pb; - pb->val = bptr; - pb->bytes = (byte*) bptr->orig_bytes; - pb->flags = 0; - - OH_OVERHEAD(&(MSO(c_p)), BsOp1 / sizeof(Eterm)); - - xb(Arg(2)) = make_binary(pb); - Next(3); - } - - OpCase(i_bs_init_heap_bin_heap_IIIx): { - BsOp1 = Arg(0); - BsOp2 = Arg(1); - I++; - goto do_heap_bin_alloc; - } - - OpCase(i_bs_init_heap_bin_IIx): { - BsOp1 = Arg(0); - BsOp2 = 0; - } - /* Fall through */ - do_heap_bin_alloc: - { - ErlHeapBin* hb; - Uint bin_need; - - bin_need = heap_bin_size(BsOp1); - erts_bin_offset = 0; - erts_writable_bin = 0; - TestHeap(bin_need+BsOp2+ERL_SUB_BIN_SIZE, Arg(1)); - hb = (ErlHeapBin *) HTOP; - HTOP += bin_need; - hb->thing_word = header_heap_bin(BsOp1); - hb->size = BsOp1; - erts_current_bin = (byte *) hb->data; - BsOp1 = make_binary(hb); - xb(Arg(2)) = BsOp1; - Next(3); - } - } - - OpCase(bs_add_jssIx): { - Eterm Op1, Op2; - Uint Unit = Arg(3); - - GetArg2(1, Op1, Op2); - if (is_both_small(Op1, Op2)) { - Sint Arg1 = signed_val(Op1); - Sint Arg2 = signed_val(Op2); - - if (Arg1 >= 0 && Arg2 >= 0) { - BsSafeMul(Arg2, Unit, goto system_limit, Op1); - Op1 += Arg1; - - store_bs_add_result: - if (Op1 <= MAX_SMALL) { - Op1 = make_small(Op1); - } else { - /* - * May generate a heap fragment, but in this - * particular case it is OK, since the value will be - * stored into an x register (the GC will scan x - * registers for references to heap fragments) and - * there is no risk that value can be stored into a - * location that is not scanned for heap-fragment - * references (such as the heap). - */ - SWAPOUT; - Op1 = erts_make_integer(Op1, c_p); - HTOP = HEAP_TOP(c_p); - } - xb(Arg(4)) = Op1; - Next(5); - } - goto badarg; - } else { - Uint a; - Uint b; - Uint c; - - /* - * Now we know that one of the arguments is - * not a small. We must convert both arguments - * to Uints and check for errors at the same time. - * - * Error checking is tricky. - * - * If one of the arguments is not numeric or - * not positive, the error reason is BADARG. - * - * Otherwise if both arguments are numeric, - * but at least one argument does not fit in - * an Uint, the reason is SYSTEM_LIMIT. - */ - - if (!term_to_Uint(Op1, &a)) { - if (a == BADARG) { - goto badarg; - } - if (!term_to_Uint(Op2, &b)) { - c_p->freason = b; - goto lb_Cl_error; - } - goto system_limit; - } else if (!term_to_Uint(Op2, &b)) { - c_p->freason = b; - goto lb_Cl_error; - } - - /* - * The arguments are now correct and stored in a and b. - */ - - BsSafeMul(b, Unit, goto system_limit, c); - Op1 = a + c; - if (Op1 < a) { - /* - * If the result is less than one of the - * arguments, there must have been an overflow. - */ - goto system_limit; - } - goto store_bs_add_result; - } - /* No fallthrough */ - ASSERT(0); - } - - OpCase(bs_put_string_II): - { - BeamInstr *next; - PreFetch(2, next); - erts_new_bs_put_string(ERL_BITS_ARGS_2((byte *) Arg(1), Arg(0))); - NextPF(2, next); - } - - /* - * x(SCRATCH_X_REG); - * Operands: Fail ExtraHeap Live Unit Size Dst - */ - - OpCase(i_bs_append_jIIIsx): { - Uint live = Arg(2); - Uint res; - Eterm Size; - - GetArg1(4, Size); - HEAVY_SWAPOUT; - reg[live] = x(SCRATCH_X_REG); - res = erts_bs_append(c_p, reg, live, Size, Arg(1), Arg(3)); - HEAVY_SWAPIN; - if (is_non_value(res)) { - /* c_p->freason is already set (may be either BADARG or SYSTEM_LIMIT). */ - goto lb_Cl_error; - } - xb(Arg(5)) = res; - Next(6); - } - - /* - * Operands: Fail Size Src Unit Dst - */ - OpCase(i_bs_private_append_jIssx): { - Eterm res; - Eterm Size, Src; - - GetArg2(2, Size, Src); - res = erts_bs_private_append(c_p, Src, Size, Arg(1)); - if (is_non_value(res)) { - /* c_p->freason is already set (may be either BADARG or SYSTEM_LIMIT). */ - goto lb_Cl_error; - } - xb(Arg(4)) = res; - Next(5); - } - - OpCase(bs_init_writable): { - HEAVY_SWAPOUT; - r(0) = erts_bs_init_writable(c_p, r(0)); - HEAVY_SWAPIN; - Next(0); - } - - /* - * Calculate the number of bytes needed to encode the source - * operarand to UTF-8. If the source operand is invalid (e.g. wrong - * type or range) we return a nonsense integer result (0 or 4). We - * can get away with that because we KNOW that bs_put_utf8 will do - * full error checking. - */ - OpCase(i_bs_utf8_size_sx): { - Eterm arg; - Eterm result; - - GetArg1(0, arg); - if (arg < make_small(0x80UL)) { - result = make_small(1); - } else if (arg < make_small(0x800UL)) { - result = make_small(2); - } else if (arg < make_small(0x10000UL)) { - result = make_small(3); - } else { - result = make_small(4); - } - xb(Arg(1)) = result; - Next(2); - } - - OpCase(i_bs_put_utf8_js): { - Eterm arg; - - GetArg1(1, arg); - if (!erts_bs_put_utf8(ERL_BITS_ARGS_1(arg))) { - goto badarg; - } - Next(2); - } - - /* - * Calculate the number of bytes needed to encode the source - * operarand to UTF-8. If the source operand is invalid (e.g. wrong - * type or range) we return a nonsense integer result (2 or 4). We - * can get away with that because we KNOW that bs_put_utf16 will do - * full error checking. - */ - - OpCase(i_bs_utf16_size_sx): { - Eterm arg; - Eterm result = make_small(2); - - GetArg1(0, arg); - if (arg >= make_small(0x10000UL)) { - result = make_small(4); - } - xb(Arg(1)) = result; - Next(2); - } - - OpCase(bs_put_utf16_jIs): { - Eterm arg; - - GetArg1(2, arg); - if (!erts_bs_put_utf16(ERL_BITS_ARGS_2(arg, Arg(1)))) { - goto badarg; - } - Next(3); - } - - /* - * Only used for validating a value about to be stored in a binary. - */ - OpCase(i_bs_validate_unicode_js): { - Eterm val; - - GetArg1(1, val); - - /* - * There is no need to untag the integer, but it IS necessary - * to make sure it is small (if the term is a bignum, it could - * slip through the test, and there is no further test that - * would catch it, since bit syntax construction silently masks - * too big numbers). - */ - if (is_not_small(val) || val > make_small(0x10FFFFUL) || - (make_small(0xD800UL) <= val && val <= make_small(0xDFFFUL))) { - goto badarg; - } - Next(2); - } - - /* - * Only used for validating a value matched out. - */ - OpCase(i_bs_validate_unicode_retract_jss): { - Eterm i; /* Integer to validate */ - - /* - * There is no need to untag the integer, but it IS necessary - * to make sure it is small (a bignum pointer could fall in - * the valid range). - */ - - GetArg1(1, i); - if (is_not_small(i) || i > make_small(0x10FFFFUL) || - (make_small(0xD800UL) <= i && i <= make_small(0xDFFFUL))) { - Eterm ms; /* Match context */ - ErlBinMatchBuffer* mb; - - GetArg1(2, ms); - mb = ms_matchbuffer(ms); - mb->offset -= 32; - goto badarg; - } - Next(3); - } - - /* - * Matching of binaries. - */ - - { - Eterm header; - BeamInstr *next; - Uint slots; - Eterm context; - - do_start_match: - slots = Arg(2); - if (!is_boxed(context)) { - ClauseFail(); - } - PreFetch(4, next); - header = *boxed_val(context); - if (header_is_bin_matchstate(header)) { - ErlBinMatchState* ms = (ErlBinMatchState *) boxed_val(context); - Uint actual_slots = HEADER_NUM_SLOTS(header); - ms->save_offset[0] = ms->mb.offset; - if (actual_slots < slots) { - ErlBinMatchState* dst; - Uint live = Arg(1); - Uint wordsneeded = ERL_BIN_MATCHSTATE_SIZE(slots); - - TestHeapPreserve(wordsneeded, live, context); - ms = (ErlBinMatchState *) boxed_val(context); - dst = (ErlBinMatchState *) HTOP; - *dst = *ms; - *HTOP = HEADER_BIN_MATCHSTATE(slots); - HTOP += wordsneeded; - HEAP_SPACE_VERIFIED(0); - xb(Arg(3)) = make_matchstate(dst); - } - } else if (is_binary_header(header)) { - Eterm result; - Uint live = Arg(1); - Uint wordsneeded = ERL_BIN_MATCHSTATE_SIZE(slots); - TestHeapPreserve(wordsneeded, live, context); - HEAP_TOP(c_p) = HTOP; -#ifdef DEBUG - c_p->stop = E; /* Needed for checking in HeapOnlyAlloc(). */ -#endif - result = erts_bs_start_match_2(c_p, context, slots); - HTOP = HEAP_TOP(c_p); - HEAP_SPACE_VERIFIED(0); - if (is_non_value(result)) { - ClauseFail(); - } else { - xb(Arg(3)) = result; - } - } else { - ClauseFail(); - } - NextPF(4, next); - - OpCase(i_bs_start_match2_xfIIx): { - context = xb(Arg(0)); - I++; - goto do_start_match; - } - OpCase(i_bs_start_match2_yfIIx): { - context = yb(Arg(0)); - I++; - goto do_start_match; - } - } - - OpCase(bs_test_zero_tail2_fx): { - BeamInstr *next; - ErlBinMatchBuffer *_mb; - - PreFetch(2, next); - _mb = (ErlBinMatchBuffer*) ms_matchbuffer(xb(Arg(1))); - if (_mb->size != _mb->offset) { - ClauseFail(); - } - NextPF(2, next); - } - - OpCase(bs_test_tail_imm2_fxI): { - BeamInstr *next; - ErlBinMatchBuffer *_mb; - PreFetch(3, next); - _mb = ms_matchbuffer(xb(Arg(1))); - if (_mb->size - _mb->offset != Arg(2)) { - ClauseFail(); - } - NextPF(3, next); - } - - OpCase(bs_test_unit_fxI): { - BeamInstr *next; - ErlBinMatchBuffer *_mb; - PreFetch(3, next); - _mb = ms_matchbuffer(xb(Arg(1))); - if ((_mb->size - _mb->offset) % Arg(2)) { - ClauseFail(); - } - NextPF(3, next); - } - - OpCase(bs_test_unit8_fx): { - BeamInstr *next; - ErlBinMatchBuffer *_mb; - PreFetch(2, next); - _mb = ms_matchbuffer(xb(Arg(1))); - if ((_mb->size - _mb->offset) & 7) { - ClauseFail(); - } - NextPF(2, next); - } - - { - Eterm bs_get_integer8_context; - - OpCase(i_bs_get_integer_8_xfx): { - ErlBinMatchBuffer *_mb; - Eterm _result; - bs_get_integer8_context = xb(Arg(0)); - I++; - _mb = ms_matchbuffer(bs_get_integer8_context); - if (_mb->size - _mb->offset < 8) { - ClauseFail(); - } - if (BIT_OFFSET(_mb->offset) != 0) { - _result = erts_bs_get_integer_2(c_p, 8, 0, _mb); - } else { - _result = make_small(_mb->base[BYTE_OFFSET(_mb->offset)]); - _mb->offset += 8; - } - xb(Arg(1)) = _result; - Next(2); - } - } - - { - Eterm bs_get_integer_16_context; - - OpCase(i_bs_get_integer_16_xfx): - bs_get_integer_16_context = xb(Arg(0)); - I++; - - { - ErlBinMatchBuffer *_mb; - Eterm _result; - _mb = ms_matchbuffer(bs_get_integer_16_context); - if (_mb->size - _mb->offset < 16) { - ClauseFail(); - } - if (BIT_OFFSET(_mb->offset) != 0) { - _result = erts_bs_get_integer_2(c_p, 16, 0, _mb); - } else { - _result = make_small(get_int16(_mb->base+BYTE_OFFSET(_mb->offset))); - _mb->offset += 16; - } - xb(Arg(1)) = _result; - Next(2); - } - } - - { - Eterm bs_get_integer_32_context; - - OpCase(i_bs_get_integer_32_xfIx): - bs_get_integer_32_context = xb(Arg(0)); - I++; - - { - ErlBinMatchBuffer *_mb; - Uint32 _integer; - Eterm _result; - _mb = ms_matchbuffer(bs_get_integer_32_context); - if (_mb->size - _mb->offset < 32) { ClauseFail(); } - if (BIT_OFFSET(_mb->offset) != 0) { - _integer = erts_bs_get_unaligned_uint32(_mb); - } else { - _integer = get_int32(_mb->base + _mb->offset/8); - } - _mb->offset += 32; -#if !defined(ARCH_64) - if (IS_USMALL(0, _integer)) { -#endif - _result = make_small(_integer); -#if !defined(ARCH_64) - } else { - TestHeap(BIG_UINT_HEAP_SIZE, Arg(1)); - _result = uint_to_big((Uint) _integer, HTOP); - HTOP += BIG_UINT_HEAP_SIZE; - HEAP_SPACE_VERIFIED(0); - } -#endif - xb(Arg(2)) = _result; - Next(3); - } - } - - { - Eterm Ms, Sz; - - /* Operands: x(Reg) Size Live Fail Flags Dst */ - OpCase(i_bs_get_integer_imm_xIIfIx): { - Uint wordsneeded; - Ms = xb(Arg(0)); - Sz = Arg(1); - wordsneeded = 1+WSIZE(NBYTES(Sz)); - TestHeapPreserve(wordsneeded, Arg(2), Ms); - I += 3; - /* Operands: Fail Flags Dst */ - goto do_bs_get_integer_imm; - } - - /* Operands: x(Reg) Size Fail Flags Dst */ - OpCase(i_bs_get_integer_small_imm_xIfIx): { - Ms = xb(Arg(0)); - Sz = Arg(1); - I += 2; - /* Operands: Fail Flags Dst */ - goto do_bs_get_integer_imm; - } - - /* - * Ms = match context - * Sz = size of field - * Operands: Fail Flags Dst - */ - do_bs_get_integer_imm: { - ErlBinMatchBuffer* mb; - Eterm result; - - mb = ms_matchbuffer(Ms); - LIGHT_SWAPOUT; - result = erts_bs_get_integer_2(c_p, Sz, Arg(1), mb); - LIGHT_SWAPIN; - HEAP_SPACE_VERIFIED(0); - if (is_non_value(result)) { - ClauseFail(); - } - xb(Arg(2)) = result; - Next(3); - } - } - - /* - * Operands: Fail Live FlagsAndUnit Ms Sz Dst - */ - OpCase(i_bs_get_integer_fIIssx): { - Uint flags; - Uint size; - Eterm Ms; - Eterm Sz; - ErlBinMatchBuffer* mb; - Eterm result; - - flags = Arg(2); - GetArg2(3, Ms, Sz); - BsGetFieldSize(Sz, (flags >> 3), ClauseFail(), size); - if (size >= SMALL_BITS) { - Uint wordsneeded; - /* Check bits size before potential gc. - * We do not want a gc and then realize we don't need - * the allocated space (i.e. if the op fails). - * - * Remember to re-acquire the matchbuffer after gc. - */ - - mb = ms_matchbuffer(Ms); - if (mb->size - mb->offset < size) { - ClauseFail(); - } - wordsneeded = 1+WSIZE(NBYTES((Uint) size)); - TestHeapPreserve(wordsneeded, Arg(1), Ms); - } - mb = ms_matchbuffer(Ms); - LIGHT_SWAPOUT; - result = erts_bs_get_integer_2(c_p, size, flags, mb); - LIGHT_SWAPIN; - HEAP_SPACE_VERIFIED(0); - if (is_non_value(result)) { - ClauseFail(); - } - xb(Arg(5)) = result; - Next(6); - } - - { - Eterm get_utf8_context; - - /* Operands: MatchContext Fail Dst */ - OpCase(i_bs_get_utf8_xfx): { - get_utf8_context = xb(Arg(0)); - I++; - } - - /* - * get_utf8_context = match_context - * Operands: Fail Dst - */ - - { - Eterm result = erts_bs_get_utf8(ms_matchbuffer(get_utf8_context)); - if (is_non_value(result)) { - ClauseFail(); - } - xb(Arg(1)) = result; - Next(2); - } - } - - { - Eterm get_utf16_context; - - /* Operands: MatchContext Fail Flags Dst */ - OpCase(i_bs_get_utf16_xfIx): { - get_utf16_context = xb(Arg(0)); - I++; - } - - /* - * get_utf16_context = match_context - * Operands: Fail Flags Dst - */ - { - Eterm result = erts_bs_get_utf16(ms_matchbuffer(get_utf16_context), - Arg(1)); - if (is_non_value(result)) { - ClauseFail(); - } - xb(Arg(2)) = result; - Next(3); - } - } - - { - Eterm context_to_binary_context; - ErlBinMatchBuffer* mb; - ErlSubBin* sb; - Uint size; - Uint offs; - Uint orig; - Uint hole_size; - - OpCase(bs_context_to_binary_x): - context_to_binary_context = xb(Arg(0)); - I--; - - if (is_boxed(context_to_binary_context) && - header_is_bin_matchstate(*boxed_val(context_to_binary_context))) { - ErlBinMatchState* ms; - ms = (ErlBinMatchState *) boxed_val(context_to_binary_context); - mb = &ms->mb; - offs = ms->save_offset[0]; - size = mb->size - offs; - goto do_bs_get_binary_all_reuse_common; - } - Next(2); - - OpCase(i_bs_get_binary_all_reuse_xfI): { - context_to_binary_context = xb(Arg(0)); - I++; - } - - mb = ms_matchbuffer(context_to_binary_context); - size = mb->size - mb->offset; - if (size % Arg(1) != 0) { - ClauseFail(); - } - offs = mb->offset; - - do_bs_get_binary_all_reuse_common: - orig = mb->orig; - sb = (ErlSubBin *) boxed_val(context_to_binary_context); - hole_size = 1 + header_arity(sb->thing_word) - ERL_SUB_BIN_SIZE; - sb->thing_word = HEADER_SUB_BIN; - sb->size = BYTE_OFFSET(size); - sb->bitsize = BIT_OFFSET(size); - sb->offs = BYTE_OFFSET(offs); - sb->bitoffs = BIT_OFFSET(offs); - sb->is_writable = 0; - sb->orig = orig; - if (hole_size) { - sb[1].thing_word = make_pos_bignum_header(hole_size-1); - } - Next(2); - } - - { - Eterm match_string_context; - - OpCase(i_bs_match_string_xfII): { - match_string_context = xb(Arg(0)); - I++; - } - - { - BeamInstr *next; - byte* bytes; - Uint bits; - ErlBinMatchBuffer* mb; - Uint offs; - - PreFetch(3, next); - bits = Arg(1); - bytes = (byte *) Arg(2); - mb = ms_matchbuffer(match_string_context); - if (mb->size - mb->offset < bits) { - ClauseFail(); - } - offs = mb->offset & 7; - if (offs == 0 && (bits & 7) == 0) { - if (sys_memcmp(bytes, mb->base+(mb->offset>>3), bits>>3)) { - ClauseFail(); - } - } else if (erts_cmp_bits(bytes, 0, mb->base+(mb->offset>>3), mb->offset & 7, bits)) { - ClauseFail(); - } - mb->offset += bits; - NextPF(3, next); - } - } - - OpCase(i_bs_save2_xI): { - BeamInstr *next; - ErlBinMatchState *_ms; - PreFetch(2, next); - _ms = (ErlBinMatchState*) boxed_val((Eterm) xb(Arg(0))); - _ms->save_offset[Arg(1)] = _ms->mb.offset; - NextPF(2, next); - } - - OpCase(i_bs_restore2_xI): { - BeamInstr *next; - ErlBinMatchState *_ms; - PreFetch(2, next); - _ms = (ErlBinMatchState*) boxed_val((Eterm) xb(Arg(0))); - _ms->mb.offset = _ms->save_offset[Arg(1)]; - NextPF(2, next); - } - #include "beam_cold.h" - /* - * Trace and debugging support. - */ - - OpCase(return_trace): { - ErtsCodeMFA* mfa = (ErtsCodeMFA *)(E[0]); - - SWAPOUT; /* Needed for shared heap */ - ERTS_UNREQ_PROC_MAIN_LOCK(c_p); - erts_trace_return(c_p, mfa, r(0), ERTS_TRACER_FROM_ETERM(E+1)/* tracer */); - ERTS_REQ_PROC_MAIN_LOCK(c_p); - SWAPIN; - c_p->cp = NULL; - SET_I((BeamInstr *) cp_val(E[2])); - E += 3; - Goto(*I); - } - - OpCase(i_generic_breakpoint): { - BeamInstr real_I; - HEAVY_SWAPOUT; - real_I = erts_generic_breakpoint(c_p, erts_code_to_codeinfo(I), reg); - HEAVY_SWAPIN; - ASSERT(VALID_INSTR(real_I)); - Goto(real_I); - } - - OpCase(i_return_time_trace): { - BeamInstr *pc = (BeamInstr *) (UWord) E[0]; - SWAPOUT; - erts_trace_time_return(c_p, erts_code_to_codeinfo(pc)); - SWAPIN; - c_p->cp = NULL; - SET_I((BeamInstr *) cp_val(E[1])); - E += 2; - Goto(*I); - } - - OpCase(i_return_to_trace): { - if (IS_TRACED_FL(c_p, F_TRACE_RETURN_TO)) { - Uint *cpp = (Uint*) E; - for(;;) { - ASSERT(is_CP(*cpp)); - if (*cp_val(*cpp) == (BeamInstr) OpCode(return_trace)) { - do ++cpp; while(is_not_CP(*cpp)); - cpp += 2; - } else if (*cp_val(*cpp) == (BeamInstr) OpCode(i_return_to_trace)) { - do ++cpp; while(is_not_CP(*cpp)); - } else break; - } - SWAPOUT; /* Needed for shared heap */ - ERTS_UNREQ_PROC_MAIN_LOCK(c_p); - erts_trace_return_to(c_p, cp_val(*cpp)); - ERTS_REQ_PROC_MAIN_LOCK(c_p); - SWAPIN; - } - c_p->cp = NULL; - SET_I((BeamInstr *) cp_val(E[0])); - E += 1; - Goto(*I); - } - - /* - * New floating point instructions. - */ - - OpCase(fmove_ql): { - Eterm fr = Arg(1); - BeamInstr *next; - - PreFetch(2, next); - GET_DOUBLE(Arg(0), *(FloatDef*)ADD_BYTE_OFFSET(freg, fr)); - NextPF(2, next); - } - - OpCase(fmove_dl): { - Eterm targ1; - Eterm fr = Arg(1); - BeamInstr *next; - - PreFetch(2, next); - targ1 = REG_TARGET(Arg(0)); - /* Arg(0) == HEADER_FLONUM */ - GET_DOUBLE(targ1, *(FloatDef*)ADD_BYTE_OFFSET(freg, fr)); - NextPF(2, next); - } - - OpCase(fmove_ld): { - Eterm fr = Arg(0); - Eterm dest = make_float(HTOP); - - PUT_DOUBLE(*(FloatDef*)ADD_BYTE_OFFSET(freg, fr), HTOP); - HTOP += FLOAT_SIZE_OBJECT; - StoreBifResult(1, dest); - } - - OpCase(fconv_dl): { - Eterm targ1; - Eterm fr = Arg(1); - BeamInstr *next; - - targ1 = REG_TARGET(Arg(0)); - PreFetch(2, next); - if (is_small(targ1)) { - lb(fr) = (double) signed_val(targ1); - } else if (is_big(targ1)) { - if (big_to_double(targ1, &lb(fr)) < 0) { - goto fbadarith; - } - } else if (is_float(targ1)) { - GET_DOUBLE(targ1, *(FloatDef*)ADD_BYTE_OFFSET(freg, fr)); - } else { - goto fbadarith; - } - NextPF(2, next); - } - -#ifdef NO_FPE_SIGNALS - OpCase(fclearerror): - OpCase(i_fcheckerror): - erts_exit(ERTS_ERROR_EXIT, "fclearerror/i_fcheckerror without fpe signals (beam_emu)"); -# define ERTS_NO_FPE_CHECK_INIT ERTS_FP_CHECK_INIT -# define ERTS_NO_FPE_ERROR ERTS_FP_ERROR -#else -# define ERTS_NO_FPE_CHECK_INIT(p) -# define ERTS_NO_FPE_ERROR(p, a, b) - - OpCase(fclearerror): { - BeamInstr *next; - - PreFetch(0, next); - ERTS_FP_CHECK_INIT(c_p); - NextPF(0, next); - } - - OpCase(i_fcheckerror): { - BeamInstr *next; - - PreFetch(0, next); - ERTS_FP_ERROR(c_p, freg[0].fd, goto fbadarith); - NextPF(0, next); - } -#endif - - - OpCase(i_fadd_lll): { - BeamInstr *next; - - PreFetch(3, next); - ERTS_NO_FPE_CHECK_INIT(c_p); - lb(Arg(2)) = lb(Arg(0)) + lb(Arg(1)); - ERTS_NO_FPE_ERROR(c_p, lb(Arg(2)), goto fbadarith); - NextPF(3, next); - } - OpCase(i_fsub_lll): { - BeamInstr *next; - - PreFetch(3, next); - ERTS_NO_FPE_CHECK_INIT(c_p); - lb(Arg(2)) = lb(Arg(0)) - lb(Arg(1)); - ERTS_NO_FPE_ERROR(c_p, lb(Arg(2)), goto fbadarith); - NextPF(3, next); - } - OpCase(i_fmul_lll): { - BeamInstr *next; - - PreFetch(3, next); - ERTS_NO_FPE_CHECK_INIT(c_p); - lb(Arg(2)) = lb(Arg(0)) * lb(Arg(1)); - ERTS_NO_FPE_ERROR(c_p, lb(Arg(2)), goto fbadarith); - NextPF(3, next); - } - OpCase(i_fdiv_lll): { - BeamInstr *next; - - PreFetch(3, next); - ERTS_NO_FPE_CHECK_INIT(c_p); - lb(Arg(2)) = lb(Arg(0)) / lb(Arg(1)); - ERTS_NO_FPE_ERROR(c_p, lb(Arg(2)), goto fbadarith); - NextPF(3, next); - } - OpCase(i_fnegate_ll): { - BeamInstr *next; - - PreFetch(2, next); - ERTS_NO_FPE_CHECK_INIT(c_p); - lb(Arg(1)) = -lb(Arg(0)); - ERTS_NO_FPE_ERROR(c_p, lb(Arg(1)), goto fbadarith); - NextPF(2, next); - - fbadarith: - c_p->freason = BADARITH; - goto find_func_info; - } - -#ifdef HIPE - { -#define HIPE_MODE_SWITCH(Cmd) \ - SWAPOUT; \ - ERTS_DBG_CHK_REDS(c_p, FCALLS); \ - c_p->fcalls = FCALLS; \ - c_p->def_arg_reg[4] = -neg_o_reds; \ - c_p = hipe_mode_switch(c_p, Cmd, reg); \ - goto L_post_hipe_mode_switch - - OpCase(hipe_trap_call): { - /* - * I[-5]: &&lb_i_func_info_IaaI - * I[-4]: Native code callee (inserted by HiPE) - * I[-3]: Module (tagged atom) - * I[-2]: Function (tagged atom) - * I[-1]: Arity (untagged integer) - * I[ 0]: &&lb_hipe_trap_call - * ... remainder of original BEAM code - */ - ErtsCodeInfo *ci = erts_code_to_codeinfo(I); - ASSERT(ci->op == (Uint) OpCode(i_func_info_IaaI)); - c_p->hipe.u.ncallee = ci->u.ncallee; - ++hipe_trap_count; - HIPE_MODE_SWITCH(HIPE_MODE_SWITCH_CMD_CALL | (ci->mfa.arity << 8)); - } - OpCase(hipe_trap_call_closure): { - ErtsCodeInfo *ci = erts_code_to_codeinfo(I); - ASSERT(ci->op == (Uint) OpCode(i_func_info_IaaI)); - c_p->hipe.u.ncallee = ci->u.ncallee; - ++hipe_trap_count; - HIPE_MODE_SWITCH(HIPE_MODE_SWITCH_CMD_CALL_CLOSURE | (ci->mfa.arity << 8)); - } - OpCase(hipe_trap_return): { - HIPE_MODE_SWITCH(HIPE_MODE_SWITCH_CMD_RETURN); - } - OpCase(hipe_trap_throw): { - HIPE_MODE_SWITCH(HIPE_MODE_SWITCH_CMD_THROW); - } - OpCase(hipe_trap_resume): { - HIPE_MODE_SWITCH(HIPE_MODE_SWITCH_CMD_RESUME); - } -#undef HIPE_MODE_SWITCH - - L_post_hipe_mode_switch: -#ifdef DEBUG - pid = c_p->common.id; /* may have switched process... */ -#endif - reg = erts_proc_sched_data(c_p)->x_reg_array; - freg = erts_proc_sched_data(c_p)->f_reg_array; - ERL_BITS_RELOAD_STATEP(c_p); - /* XXX: this abuse of def_arg_reg[] is horrid! */ - neg_o_reds = -c_p->def_arg_reg[4]; - FCALLS = c_p->fcalls; - SWAPIN; - ERTS_DBG_CHK_REDS(c_p, FCALLS); - switch( c_p->def_arg_reg[3] ) { - case HIPE_MODE_SWITCH_RES_RETURN: - ASSERT(is_value(reg[0])); - SET_I(c_p->cp); - c_p->cp = 0; - Goto(*I); - case HIPE_MODE_SWITCH_RES_CALL_EXPORTED: - c_p->i = c_p->hipe.u.callee_exp->addressv[erts_active_code_ix()]; - /*fall through*/ - case HIPE_MODE_SWITCH_RES_CALL_BEAM: - SET_I(c_p->i); - Dispatch(); - case HIPE_MODE_SWITCH_RES_CALL_CLOSURE: - /* This can be used to call any function value, but currently it's - only used to call closures referring to unloaded modules. */ - { - BeamInstr *next; - - next = call_fun(c_p, c_p->arity - 1, reg, THE_NON_VALUE); - HEAVY_SWAPIN; - if (next != NULL) { - SET_I(next); - Dispatchfun(); - } - goto find_func_info; - } - case HIPE_MODE_SWITCH_RES_THROW: - c_p->cp = NULL; - I = handle_error(c_p, I, reg, NULL); - goto post_error_handling; - default: - erts_exit(ERTS_ERROR_EXIT, "hipe_mode_switch: result %u\n", c_p->def_arg_reg[3]); - } - } - OpCase(hipe_call_count): { - /* - * I[-5]: &&lb_i_func_info_IaaI - * I[-4]: pointer to struct hipe_call_count (inserted by HiPE) - * I[-3]: Module (tagged atom) - * I[-2]: Function (tagged atom) - * I[-1]: Arity (untagged integer) - * I[ 0]: &&lb_hipe_call_count - * ... remainder of original BEAM code - */ - ErtsCodeInfo *ci = erts_code_to_codeinfo(I); - struct hipe_call_count *hcc = ci->u.hcc; - ASSERT(ci->op == (Uint) OpCode(i_func_info_IaaI)); - ASSERT(hcc != NULL); - ASSERT(VALID_INSTR(hcc->opcode)); - ++(hcc->count); - Goto(hcc->opcode); - } -#endif /* HIPE */ - - OpCase(i_yield): - { - /* This is safe as long as REDS_IN(c_p) is never stored - * in c_p->arg_reg[0]. It is currently stored in c_p->def_arg_reg[5], - * which may be c_p->arg_reg[5], which is close, but no banana. - */ - c_p->arg_reg[0] = am_true; - c_p->arity = 1; /* One living register (the 'true' return value) */ - SWAPOUT; - c_p->i = I + 1; /* Next instruction */ - c_p->current = NULL; - goto do_schedule; - } - - OpCase(i_hibernate): { - HEAVY_SWAPOUT; - if (erts_hibernate(c_p, r(0), x(1), x(2), reg)) { - FCALLS = c_p->fcalls; - c_p->flags &= ~F_HIBERNATE_SCHED; - goto do_schedule; - } else { - HEAVY_SWAPIN; - I = handle_error(c_p, I, reg, &bif_export[BIF_hibernate_3]->info.mfa); - goto post_error_handling; - } - } - - /* This is optimised as an instruction because - it has to be very very fast */ - OpCase(i_perf_counter): { - BeamInstr* next; - ErtsSysPerfCounter ts; - PreFetch(0, next); - - ts = erts_sys_perf_counter(); - - if (IS_SSMALL(ts)) { - r(0) = make_small((Sint)ts); - } else { - TestHeap(ERTS_SINT64_HEAP_SIZE(ts),0); - r(0) = make_big(HTOP); -#if defined(ARCH_32) - if (ts >= (((Uint64) 1) << 32)) { - *HTOP = make_pos_bignum_header(2); - BIG_DIGIT(HTOP, 0) = (Uint) (ts & ((Uint) 0xffffffff)); - BIG_DIGIT(HTOP, 1) = (Uint) ((ts >> 32) & ((Uint) 0xffffffff)); - HTOP += 3; - } - else -#endif - { - *HTOP = make_pos_bignum_header(1); - BIG_DIGIT(HTOP, 0) = (Uint) ts; - HTOP += 2; - } - } - NextPF(0, next); - } - - OpCase(i_debug_breakpoint): { - HEAVY_SWAPOUT; - I = call_error_handler(c_p, erts_code_to_codemfa(I), reg, am_breakpoint); - HEAVY_SWAPIN; - if (I) { - Goto(*I); - } - goto handle_error; - } - - - OpCase(system_limit_j): - system_limit: - c_p->freason = SYSTEM_LIMIT; - goto lb_Cl_error; - - #ifdef ERTS_OPCODE_COUNTER_SUPPORT DEFINE_COUNTING_LABELS; #endif @@ -5872,7 +2329,6 @@ erts_hibernate(Process* c_p, Eterm module, Eterm function, Eterm args, Eterm* re int arity; Eterm tmp; - if (is_not_atom(module) || is_not_atom(function)) { /* * No need to test args here -- done below. diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index 5429a61d7b..d38e71f489 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -83,8 +83,9 @@ ErlDrvBinary* erts_gzinflate_buffer(char*, int); typedef struct { Uint value; /* Value of label (NULL if not known yet). */ - Sint patches; /* Index (into code buffer) to first location - * which must be patched with the value of this label. + Sint patches; /* Index (into code buffer) to first + * location which must be patched with + * the value of this label. */ Uint looprec_targeted; /* Non-zero if this label is the target of a loop_rec * instruction. @@ -2871,15 +2872,15 @@ gen_element(LoaderState* stp, GenOpArg Fail, GenOpArg Index, if (Index.type == TAG_i && Index.val > 0 && (Tuple.type == TAG_x || Tuple.type == TAG_y)) { op->op = genop_i_fast_element_4; - op->a[0] = Fail; - op->a[1] = Tuple; + op->a[0] = Tuple; + op->a[1] = Fail; op->a[2].type = TAG_u; op->a[2].val = Index.val; op->a[3] = Dst; } else { op->op = genop_i_element_4; - op->a[0] = Fail; - op->a[1] = Tuple; + op->a[0] = Tuple; + op->a[1] = Fail; op->a[2] = Index; op->a[3] = Dst; } @@ -2959,13 +2960,14 @@ gen_get_integer2(LoaderState* stp, GenOpArg Fail, GenOpArg Ms, GenOpArg Live, op->a[0] = Ms; op->a[1] = Fail; op->a[2] = Dst; +#ifdef ARCH_64 } else if (bits == 32 && (Flags.val & BSF_LITTLE) == 0) { - op->op = genop_i_bs_get_integer_32_4; - op->arity = 4; + op->op = genop_i_bs_get_integer_32_3; + op->arity = 3; op->a[0] = Ms; op->a[1] = Fail; - op->a[2] = Live; - op->a[3] = Dst; + op->a[2] = Dst; +#endif } else { generic: if (bits < SMALL_BITS) { @@ -3100,16 +3102,6 @@ gen_get_binary2(LoaderState* stp, GenOpArg Fail, GenOpArg Ms, GenOpArg Live, } /* - * Predicate to test whether a heap binary should be generated. - */ - -static int -should_gen_heap_bin(LoaderState* stp, GenOpArg Src) -{ - return Src.val <= ERL_ONHEAP_BIN_LIMIT; -} - -/* * Predicate to test whether a binary construction is too big. */ @@ -3381,13 +3373,6 @@ negation_is_small(LoaderState* stp, GenOpArg Int) IS_SSMALL(-((Sint)Int.val)); } - -static int -smp(LoaderState* stp) -{ - return 1; -} - /* * Mark this label. */ @@ -3421,11 +3406,11 @@ gen_literal_timeout(LoaderState* stp, GenOpArg Fail, GenOpArg Time) Sint timeout; NEW_GENOP(stp, op); - op->op = genop_i_wait_timeout_2; + op->op = genop_wait_timeout_unlocked_2; op->next = NULL; op->arity = 2; - op->a[0] = Fail; - op->a[1].type = TAG_u; + op->a[0].type = TAG_u; + op->a[1] = Fail; if (Time.type == TAG_i && (timeout = Time.val) >= 0 && #if defined(ARCH_64) @@ -3434,7 +3419,7 @@ gen_literal_timeout(LoaderState* stp, GenOpArg Fail, GenOpArg Time) 1 #endif ) { - op->a[1].val = timeout; + op->a[0].val = timeout; #if !defined(ARCH_64) } else if (Time.type == TAG_q) { Eterm big; @@ -3448,7 +3433,7 @@ gen_literal_timeout(LoaderState* stp, GenOpArg Fail, GenOpArg Time) } else { Uint u; (void) term_to_Uint(big, &u); - op->a[1].val = (BeamInstr) u; + op->a[0].val = (BeamInstr) u; } #endif } else { @@ -3468,7 +3453,7 @@ gen_literal_timeout_locked(LoaderState* stp, GenOpArg Fail, GenOpArg Time) Sint timeout; NEW_GENOP(stp, op); - op->op = genop_i_wait_timeout_locked_2; + op->op = genop_wait_timeout_locked_2; op->next = NULL; op->arity = 2; op->a[0] = Fail; diff --git a/erts/emulator/beam/bif_instrs.tab b/erts/emulator/beam/bif_instrs.tab new file mode 100644 index 0000000000..5aa0523e06 --- /dev/null +++ b/erts/emulator/beam/bif_instrs.tab @@ -0,0 +1,539 @@ +// -*- c -*- +// +// %CopyrightBegin% +// +// Copyright Ericsson AB 2017. All Rights Reserved. +// +// Licensed under the Apache License, Version 2.0 (the "License"); +// you may not use this file except in compliance with the License. +// You may obtain a copy of the License at +// +// http://www.apache.org/licenses/LICENSE-2.0 +// +// Unless required by applicable law or agreed to in writing, software +// distributed under the License is distributed on an "AS IS" BASIS, +// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +// See the License for the specific language governing permissions and +// limitations under the License. +// +// %CopyrightEnd% +// + +// ================================================================ +// All guards with zero arguments have special instructions, +// for example: +// +// self/0 +// node/0 +// +// All other guard BIFs take one or two arguments. +// ================================================================ + +CALL_GUARD_BIF(BF, TmpReg, Dst) { + Eterm result; + + 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); + result = (*$BF)(c_p, $TmpReg, I); + ERTS_CHK_MBUF_SZ(c_p); + ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result)); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); + PROCESS_MAIN_CHK_LOCKS(c_p); + ERTS_HOLE_CHECK(c_p); + FCALLS = c_p->fcalls; + ERTS_DBG_CHK_REDS(c_p, FCALLS); + if (is_value(result)) { + $Dst = result; + $NEXT0(); + } +} + +// Guard BIF in head. On failure, ignore the error and jump +// to the code for the next clause. We don't support tracing +// of guard BIFs. + +bif1(Fail, Bif, Src, Dst) { + ErtsBifFunc bf; + Eterm tmp_reg[1]; + + tmp_reg[0] = $Src; + bf = (BifFunction) $Bif; + $CALL_GUARD_BIF(bf, tmp_reg, $Dst); + + $FAIL($Fail); +} + +// +// Guard BIF in body. It can fail like any BIF. No trace support. +// + +bif1_body(Bif, Src, Dst) { + ErtsBifFunc bf; + Eterm tmp_reg[1]; + + tmp_reg[0] = $Src; + bf = (BifFunction) $Bif; + $CALL_GUARD_BIF(bf, tmp_reg, $Dst); + + reg[0] = tmp_reg[0]; + SWAPOUT; + I = handle_error(c_p, I, reg, ubif2mfa((void *) bf)); + goto post_error_handling; +} + +// +// Guard bif in guard with two arguments ('and'/2, 'or'/2, 'xor'/2). +// + +i_bif2(Fail, Bif, Src1, Src2, Dst) { + Eterm tmp_reg[2]; + ErtsBifFunc bf; + + tmp_reg[0] = $Src1; + tmp_reg[1] = $Src2; + bf = (ErtsBifFunc) $Bif; + $CALL_GUARD_BIF(bf, tmp_reg, $Dst); + $FAIL($Fail); +} + +// +// Guard bif in body with two arguments ('and'/2, 'or'/2, 'xor'/2). +// + +i_bif2_body(Bif, Src1, Src2, Dst) { + Eterm tmp_reg[2]; + ErtsBifFunc bf; + + tmp_reg[0] = $Src1; + tmp_reg[1] = $Src2; + bf = (ErtsBifFunc) $Bif; + $CALL_GUARD_BIF(bf, tmp_reg, $Dst); + reg[0] = tmp_reg[0]; + reg[1] = tmp_reg[1]; + SWAPOUT; + I = handle_error(c_p, I, reg, ubif2mfa((void *) bf)); + 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 (is_value(result)) { + $REFRESH_GEN_DEST(); + $Dst = result; + $NEXT0(); + } + if ($Fail != 0) { /* Handle error in guard. */ + $NEXT($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++; + + 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 (is_value(result)) { + $REFRESH_GEN_DEST(); + $Dst = result; + $NEXT0(); + } + + if ($Fail != 0) { /* Handle error in guard. */ + $NEXT($Fail); + } + + /* 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; +} + +// +// 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; + + /* + * 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; + + 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 (is_value(result)) { + $REFRESH_GEN_DEST(); + $Dst = result; + $NEXT0(); + } + + /* Handle error in guard. */ + if ($Fail != 0) { + $NEXT($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)); + goto post_error_handling; +} + +// +// The most general BIF call. The BIF may build any amount of data +// on the heap. The result is always returned in r(0). +// +call_bif(Exp) { + ErtsBifFunc bf; + Eterm result; + ErlHeapFragment *live_hf_end; + Export *export = (Export*) $Exp; + + if (!((FCALLS - 1) > 0 || (FCALLS-1) > neg_o_reds)) { + /* If we have run out of reductions, we do a context + switch before calling the bif */ + c_p->arity = GET_BIF_ARITY(export); + c_p->current = &export->info.mfa; + goto context_switch3; + } + + ERTS_MSACC_SET_BIF_STATE_CACHED_X(GET_BIF_MODULE(export), + GET_BIF_ADDRESS(export)); + + bf = GET_BIF_ADDRESS(export); + + PRE_BIF_SWAPOUT(c_p); + ERTS_DBG_CHK_REDS(c_p, FCALLS); + c_p->fcalls = FCALLS - 1; + if (FCALLS <= 0) { + save_calls(c_p, export); + } + ASSERT(!ERTS_PROC_IS_EXITING(c_p)); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); + live_hf_end = c_p->mbuf; + ERTS_CHK_MBUF_SZ(c_p); + result = (*bf)(c_p, reg, I); + ERTS_CHK_MBUF_SZ(c_p); + ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result)); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); + ERTS_HOLE_CHECK(c_p); + ERTS_REQ_PROC_MAIN_LOCK(c_p); + if (ERTS_IS_GC_DESIRED(c_p)) { + Uint arity = GET_BIF_ARITY(export); + result = erts_gc_after_bif_call_lhf(c_p, live_hf_end, result, + reg, arity); + E = c_p->stop; + } + PROCESS_MAIN_CHK_LOCKS(c_p); + HTOP = HEAP_TOP(c_p); + FCALLS = c_p->fcalls; + ERTS_DBG_CHK_REDS(c_p, FCALLS); + /* We have to update the cache if we are enabled in order + to make sure no book keeping is done after we disabled + msacc. We don't always do this as it is quite expensive. */ + if (ERTS_MSACC_IS_ENABLED_CACHED_X()) { + ERTS_MSACC_UPDATE_CACHE_X(); + } + ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_EMULATOR); + if (is_value(result)) { + r(0) = result; + CHECK_TERM(r(0)); + $NEXT0(); + } else if (c_p->freason == TRAP) { + SET_CP(c_p, I+2); + SET_I(c_p->i); + SWAPIN; + Dispatch(); + } + + /* + * Error handling. SWAPOUT is not needed because it was done above. + */ + ASSERT(c_p->stop == E); + I = handle_error(c_p, I, reg, &export->info.mfa); + goto post_error_handling; +} + +// +// Send is almost a standard call-BIF with two arguments, except for: +// 1. It cannot be traced. +// 2. There is no pointer to the send_2 function stored in +// the instruction. +// + +send() { + Eterm result; + + if (!(FCALLS > 0 || FCALLS > neg_o_reds)) { + /* If we have run out of reductions, we do a context + switch before calling the bif */ + c_p->arity = 2; + c_p->current = NULL; + goto context_switch3; + } + + PRE_BIF_SWAPOUT(c_p); + c_p->fcalls = FCALLS - 1; + result = erl_send(c_p, r(0), x(1)); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); + ERTS_REQ_PROC_MAIN_LOCK(c_p); + PROCESS_MAIN_CHK_LOCKS(c_p); + HTOP = HEAP_TOP(c_p); + FCALLS = c_p->fcalls; + if (is_value(result)) { + r(0) = result; + CHECK_TERM(r(0)); + } else if (c_p->freason == TRAP) { + SET_CP(c_p, I+1); + SET_I(c_p->i); + SWAPIN; + Dispatch(); + } else { + goto find_func_info; + } +} + +call_nif := nif_bif.call_nif.epilogue; +apply_bif := nif_bif.apply_bif.epilogue; + +nif_bif.head() { + Eterm nif_bif_result; + Eterm bif_nif_arity; + BifFunction vbf; + ErlHeapFragment *live_hf_end; + ErtsCodeMFA *codemfa; +} + +nif_bif.call_nif() { + /* + * call_nif is always first instruction in function: + * + * I[-3]: Module + * I[-2]: Function + * I[-1]: Arity + * I[0]: &&call_nif + * I[1]: Function pointer to NIF function + * I[2]: Pointer to erl_module_nif + * I[3]: Function pointer to dirty NIF + * + * This layout is determined by the NifExport struct + */ + + ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_NIF); + + codemfa = erts_code_to_codemfa(I); + + c_p->current = codemfa; /* current and vbf set to please handle_error */ + + DTRACE_NIF_ENTRY(c_p, codemfa); + + HEAVY_SWAPOUT; + + PROCESS_MAIN_CHK_LOCKS(c_p); + bif_nif_arity = codemfa->arity; + ERTS_UNREQ_PROC_MAIN_LOCK(c_p); + + ASSERT(!ERTS_PROC_IS_EXITING(c_p)); + { + typedef Eterm NifF(struct enif_environment_t*, int argc, Eterm argv[]); + NifF* fp = vbf = (NifF*) I[1]; + struct enif_environment_t env; + ASSERT(c_p->scheduler_data); + live_hf_end = c_p->mbuf; + ERTS_CHK_MBUF_SZ(c_p); + erts_pre_nif(&env, c_p, (struct erl_module_nif*)I[2], NULL); + nif_bif_result = (*fp)(&env, bif_nif_arity, reg); + if (env.exception_thrown) + nif_bif_result = THE_NON_VALUE; + erts_post_nif(&env); + ERTS_CHK_MBUF_SZ(c_p); + + PROCESS_MAIN_CHK_LOCKS(c_p); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); + ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_EMULATOR); + ASSERT(!env.exiting); + ASSERT(!ERTS_PROC_IS_EXITING(c_p)); + } + + DTRACE_NIF_RETURN(c_p, codemfa); +} + +nif_bif.apply_bif() { + /* + * At this point, I points to the code[0] in the export entry for + * the BIF: + * + * code[-3]: Module + * code[-2]: Function + * code[-1]: Arity + * code[0]: &&apply_bif + * code[1]: Function pointer to BIF function + */ + + if (!((FCALLS - 1) > 0 || (FCALLS - 1) > neg_o_reds)) { + /* If we have run out of reductions, we do a context + switch before calling the bif */ + goto context_switch; + } + + codemfa = erts_code_to_codemfa(I); + + ERTS_MSACC_SET_BIF_STATE_CACHED_X(codemfa->module, (BifFunction)Arg(0)); + + + /* In case we apply process_info/1,2 or load_nif/1 */ + c_p->current = codemfa; + c_p->i = I; /* In case we apply check_process_code/2. */ + c_p->arity = 0; /* To allow garbage collection on ourselves + * (check_process_code/2). + */ + DTRACE_BIF_ENTRY(c_p, codemfa); + + SWAPOUT; + ERTS_DBG_CHK_REDS(c_p, FCALLS - 1); + c_p->fcalls = FCALLS - 1; + vbf = (BifFunction) Arg(0); + PROCESS_MAIN_CHK_LOCKS(c_p); + bif_nif_arity = codemfa->arity; + ASSERT(bif_nif_arity <= 4); + ERTS_UNREQ_PROC_MAIN_LOCK(c_p); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); + { + ErtsBifFunc bf = vbf; + ASSERT(!ERTS_PROC_IS_EXITING(c_p)); + live_hf_end = c_p->mbuf; + ERTS_CHK_MBUF_SZ(c_p); + nif_bif_result = (*bf)(c_p, reg, I); + ERTS_CHK_MBUF_SZ(c_p); + ASSERT(!ERTS_PROC_IS_EXITING(c_p) || + is_non_value(nif_bif_result)); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); + PROCESS_MAIN_CHK_LOCKS(c_p); + } + /* We have to update the cache if we are enabled in order + to make sure no book keeping is done after we disabled + msacc. We don't always do this as it is quite expensive. */ + if (ERTS_MSACC_IS_ENABLED_CACHED_X()) + ERTS_MSACC_UPDATE_CACHE_X(); + ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_EMULATOR); + DTRACE_BIF_RETURN(c_p, codemfa); +} + +nif_bif.epilogue() { + ERTS_REQ_PROC_MAIN_LOCK(c_p); + ERTS_HOLE_CHECK(c_p); + if (ERTS_IS_GC_DESIRED(c_p)) { + nif_bif_result = erts_gc_after_bif_call_lhf(c_p, live_hf_end, + nif_bif_result, + reg, bif_nif_arity); + } + SWAPIN; /* There might have been a garbage collection. */ + FCALLS = c_p->fcalls; + ERTS_DBG_CHK_REDS(c_p, FCALLS); + if (is_value(nif_bif_result)) { + r(0) = nif_bif_result; + CHECK_TERM(r(0)); + SET_I(c_p->cp); + c_p->cp = 0; + Goto(*I); + } else if (c_p->freason == TRAP) { + SET_I(c_p->i); + if (c_p->flags & F_HIBERNATE_SCHED) { + c_p->flags &= ~F_HIBERNATE_SCHED; + goto do_schedule; + } + Dispatch(); + } + I = handle_error(c_p, c_p->cp, reg, c_p->current); + goto post_error_handling; +} diff --git a/erts/emulator/beam/bs_instrs.tab b/erts/emulator/beam/bs_instrs.tab index 420fd3074c..a4d4afe7d4 100644 --- a/erts/emulator/beam/bs_instrs.tab +++ b/erts/emulator/beam/bs_instrs.tab @@ -19,18 +19,90 @@ // %CopyrightEnd% // +%if ARCH_64 +BS_SAFE_MUL(A, B, Fail, Dst) { + Uint64 res = ($A) * ($B); + if (res / $B != $A) { + $Fail; + } + $Dst = res; +} +%else +BS_SAFE_MUL(A, B, Fail, Dst) { + Uint64 res = (Uint64)($A) * (Uint64)($B); + if ((res >> (8*sizeof(Uint))) != 0) { + $Fail; + } + $Dst = res; +} +%endif + +BS_GET_FIELD_SIZE(Bits, Unit, Fail, Dst) { + Sint signed_size; + Uint uint_size; + Uint temp_bits; + + if (is_small($Bits)) { + signed_size = signed_val($Bits); + if (signed_size < 0) { + $Fail; + } + uint_size = (Uint) signed_size; + } else { + if (!term_to_Uint($Bits, &temp_bits)) { + $Fail; + } + uint_size = temp_bits; + } + $BS_SAFE_MUL(uint_size, $Unit, $Fail, $Dst); +} + +BS_GET_UNCHECKED_FIELD_SIZE(Bits, Unit, Fail, Dst) { + Sint signed_size; + Uint uint_size; + Uint temp_bits; + + if (is_small($Bits)) { + signed_size = signed_val($Bits); + if (signed_size < 0) { + $Fail; + } + uint_size = (Uint) signed_size; + } else { + if (!term_to_Uint($Bits, &temp_bits)) { + $Fail; + } + uint_size = temp_bits; + } + $Dst = uint_size * $Unit; +} + +TEST_BIN_VHEAP(VNh, Nh, Live) { + Uint need = $Nh; + if (E - HTOP < need || MSO(c_p).overhead + $VNh >= BIN_VHEAP_SZ(c_p)) { + SWAPOUT; + PROCESS_MAIN_CHK_LOCKS(c_p); + FCALLS -= erts_garbage_collect_nobump(c_p, need, reg, $Live, FCALLS); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); + PROCESS_MAIN_CHK_LOCKS(c_p); + SWAPIN; + } + HEAP_SPACE_VERIFIED(need); +} + i_bs_get_binary_all2(Fail, Ms, Live, Unit, Dst) { ErlBinMatchBuffer *_mb; Eterm _result; - TestHeap(ERL_SUB_BIN_SIZE, $Live); + + $GC_TEST(0, ERL_SUB_BIN_SIZE, $Live); _mb = ms_matchbuffer($Ms); if (((_mb->size - _mb->offset) % $Unit) == 0) { - LIGHT_SWAPOUT; - _result = erts_bs_get_binary_all_2(c_p, _mb); - LIGHT_SWAPIN; - HEAP_SPACE_VERIFIED(0); - ASSERT(is_value(_result)); - $Dst = _result; + LIGHT_SWAPOUT; + _result = erts_bs_get_binary_all_2(c_p, _mb); + LIGHT_SWAPIN; + HEAP_SPACE_VERIFIED(0); + ASSERT(is_value(_result)); + $Dst = _result; } else { HEAP_SPACE_VERIFIED(0); $FAIL($Fail); @@ -41,8 +113,8 @@ i_bs_get_binary2(Fail, Ms, Live, Sz, Flags, Dst) { ErlBinMatchBuffer *_mb; Eterm _result; Uint _size; - BsGetFieldSize($Sz, (($Flags) >> 3), $FAIL($Fail), _size); - TestHeap(ERL_SUB_BIN_SIZE, $Live); + $BS_GET_FIELD_SIZE($Sz, (($Flags) >> 3), $FAIL($Fail), _size); + $GC_TEST(0, ERL_SUB_BIN_SIZE, $Live); _mb = ms_matchbuffer($Ms); LIGHT_SWAPOUT; _result = erts_bs_get_binary_2(c_p, _size, $Flags, _mb); @@ -58,7 +130,7 @@ i_bs_get_binary2(Fail, Ms, Live, Sz, Flags, Dst) { i_bs_get_binary_imm2(Fail, Ms, Live, Sz, Flags, Dst) { ErlBinMatchBuffer *_mb; Eterm _result; - TestHeap(heap_bin_size(ERL_ONHEAP_BIN_LIMIT), $Live); + $GC_TEST(0, heap_bin_size(ERL_ONHEAP_BIN_LIMIT), $Live); _mb = ms_matchbuffer($Ms); LIGHT_SWAPOUT; _result = erts_bs_get_binary_2(c_p, $Sz, $Flags, _mb); @@ -80,7 +152,7 @@ i_bs_get_float2(Fail, Ms, Live, Sz, Flags, Dst) { $FAIL($Fail); } _size *= (($Flags) >> 3); - TestHeap(FLOAT_SIZE_OBJECT, $Live); + $GC_TEST(0, FLOAT_SIZE_OBJECT, $Live); _mb = ms_matchbuffer($Ms); LIGHT_SWAPOUT; _result = erts_bs_get_float_2(c_p, _size, ($Flags), _mb); @@ -99,7 +171,7 @@ i_bs_skip_bits2(Fail, Ms, Bits, Unit) { Uint _size; _mb = ms_matchbuffer($Ms); - BsGetFieldSize($Bits, $Unit, $FAIL($Fail), _size); + $BS_GET_FIELD_SIZE($Bits, $Unit, $FAIL($Fail), _size); new_offset = _mb->offset + _size; if (new_offset <= _mb->size) { _mb->offset = new_offset; @@ -132,48 +204,820 @@ i_bs_skip_bits_imm2(Fail, Ms, Bits) { i_new_bs_put_binary(Fail, Sz, Flags, Src) { Sint _size; - BsGetUncheckedFieldSize($Sz, (($Flags) >> 3), goto badarg, _size); + $BS_GET_UNCHECKED_FIELD_SIZE($Sz, (($Flags) >> 3), $BADARG($Fail), _size); if (!erts_new_bs_put_binary(ERL_BITS_ARGS_2(($Src), _size))) { - goto badarg; + $BADARG($Fail); } } i_new_bs_put_binary_all(Fail, Src, Unit) { if (!erts_new_bs_put_binary_all(ERL_BITS_ARGS_2(($Src), ($Unit)))) { - goto badarg; + $BADARG($Fail); } } i_new_bs_put_binary_imm(Fail, Sz, Src) { if (!erts_new_bs_put_binary(ERL_BITS_ARGS_2(($Src), ($Sz)))) { - goto badarg; + $BADARG($Fail); } } i_new_bs_put_float(Fail, Sz, Flags, Src) { Sint _size; - BsGetUncheckedFieldSize($Sz, (($Flags) >> 3), goto badarg, _size); + $BS_GET_UNCHECKED_FIELD_SIZE($Sz, (($Flags) >> 3), $BADARG($Fail), _size); if (!erts_new_bs_put_float(c_p, ($Src), _size, ($Flags))) { - goto badarg; + $BADARG($Fail); } } i_new_bs_put_float_imm(Fail, Sz, Flags, Src) { if (!erts_new_bs_put_float(c_p, ($Src), ($Sz), ($Flags))) { - goto badarg; + $BADARG($Fail); } } i_new_bs_put_integer(Fail, Sz, Flags, Src) { Sint _size; - BsGetUncheckedFieldSize($Sz, (($Flags) >> 3), goto badarg, _size); + $BS_GET_UNCHECKED_FIELD_SIZE($Sz, (($Flags) >> 3), $BADARG($Fail), _size); if (!erts_new_bs_put_integer(ERL_BITS_ARGS_3(($Src), _size, ($Flags)))) { - goto badarg; + $BADARG($Fail); } } i_new_bs_put_integer_imm(Fail, Sz, Flags, Src) { if (!erts_new_bs_put_integer(ERL_BITS_ARGS_3(($Src), ($Sz), ($Flags)))) { - goto badarg; + $BADARG($Fail); + } +} + +# +# i_bs_init* +# + +i_bs_init_fail_heap := bs_init.fail_heap.verify.execute; +i_bs_init_fail := bs_init.fail.verify.execute; +i_bs_init := bs_init.plain.execute; +i_bs_init_heap := bs_init.heap.execute; + +bs_init.head() { + Eterm BsOp1; + Eterm BsOp2; +} + +bs_init.fail_heap(Size, HeapAlloc) { + BsOp1 = $Size; + BsOp2 = $HeapAlloc; +} + +bs_init.fail(Size) { + BsOp1 = $Size; + BsOp2 = 0; +} + +bs_init.plain(Size) { + BsOp1 = $Size; + BsOp2 = 0; +} + +bs_init.heap(Size, HeapAlloc) { + BsOp1 = $Size; + BsOp2 = $HeapAlloc; +} + +bs_init.verify(Fail) { + if (is_small(BsOp1)) { + Sint size = signed_val(BsOp1); + if (size < 0) { + $BADARG($Fail); + } + BsOp1 = (Eterm) size; + } else { + Uint bytes; + + if (!term_to_Uint(BsOp1, &bytes)) { + c_p->freason = bytes; + $FAIL_HEAD_OR_BODY($Fail); + } + if ((bytes >> (8*sizeof(Uint)-3)) != 0) { + $SYSTEM_LIMIT($Fail); + } + BsOp1 = (Eterm) bytes; + } +} + +bs_init.execute(Live, Dst) { + if (BsOp1 <= ERL_ONHEAP_BIN_LIMIT) { + ErlHeapBin* hb; + Uint bin_need; + + bin_need = heap_bin_size(BsOp1); + erts_bin_offset = 0; + erts_writable_bin = 0; + $GC_TEST(0, bin_need+BsOp2+ERL_SUB_BIN_SIZE, $Live); + hb = (ErlHeapBin *) HTOP; + HTOP += bin_need; + hb->thing_word = header_heap_bin(BsOp1); + hb->size = BsOp1; + erts_current_bin = (byte *) hb->data; + $Dst = make_binary(hb); + } else { + Binary* bptr; + ProcBin* pb; + + erts_bin_offset = 0; + erts_writable_bin = 0; + $TEST_BIN_VHEAP(BsOp1 / sizeof(Eterm), + BsOp2 + PROC_BIN_SIZE + ERL_SUB_BIN_SIZE, $Live); + + /* + * Allocate the binary struct itself. + */ + bptr = erts_bin_nrml_alloc(BsOp1); + erts_current_bin = (byte *) bptr->orig_bytes; + + /* + * Now allocate the ProcBin on the heap. + */ + pb = (ProcBin *) HTOP; + HTOP += PROC_BIN_SIZE; + pb->thing_word = HEADER_PROC_BIN; + pb->size = BsOp1; + pb->next = MSO(c_p).first; + MSO(c_p).first = (struct erl_off_heap_header*) pb; + pb->val = bptr; + pb->bytes = (byte*) bptr->orig_bytes; + pb->flags = 0; + + OH_OVERHEAD(&(MSO(c_p)), BsOp1 / sizeof(Eterm)); + + $Dst = make_binary(pb); + } +} + +# +# i_bs_init_bits* +# + +i_bs_init_bits := bs_init_bits.plain.execute; +i_bs_init_bits_heap := bs_init_bits.heap.execute; +i_bs_init_bits_fail := bs_init_bits.fail.verify.execute; +i_bs_init_bits_fail_heap := bs_init_bits.fail_heap.verify.execute; + +bs_init_bits.head() { + Eterm new_binary; + Eterm num_bits_term; + Uint num_bits; + Uint alloc; + Uint num_bytes; +} + +bs_init_bits.plain(NumBits) { + num_bits = $NumBits; + alloc = 0; +} + +bs_init_bits.heap(NumBits, Alloc) { + num_bits = $NumBits; + alloc = $Alloc; +} + +bs_init_bits.fail(NumBitsTerm) { + num_bits_term = $NumBitsTerm; + alloc = 0; +} + +bs_init_bits.fail_heap(NumBitsTerm, Alloc) { + num_bits_term = $NumBitsTerm; + alloc = $Alloc; +} + +bs_init_bits.verify(Fail) { + if (is_small(num_bits_term)) { + Sint size = signed_val(num_bits_term); + if (size < 0) { + $BADARG($Fail); + } + num_bits = (Uint) size; + } else { + Uint bits; + + if (!term_to_Uint(num_bits_term, &bits)) { + c_p->freason = bits; + $FAIL_HEAD_OR_BODY($Fail); + } + num_bits = (Uint) bits; + } +} + +bs_init_bits.execute(Live, Dst) { + num_bytes = ((Uint64)num_bits+(Uint64)7) >> 3; + if (num_bits & 7) { + alloc += ERL_SUB_BIN_SIZE; + } + if (num_bytes <= ERL_ONHEAP_BIN_LIMIT) { + alloc += heap_bin_size(num_bytes); + } else { + alloc += PROC_BIN_SIZE; + } + $test_heap(alloc, $Live); + + /* num_bits = Number of bits to build + * num_bytes = Number of bytes to allocate in the binary + * alloc = Total number of words to allocate on heap + * Operands: NotUsed NotUsed Dst + */ + if (num_bytes <= ERL_ONHEAP_BIN_LIMIT) { + ErlHeapBin* hb; + + erts_bin_offset = 0; + erts_writable_bin = 0; + hb = (ErlHeapBin *) HTOP; + HTOP += heap_bin_size(num_bytes); + hb->thing_word = header_heap_bin(num_bytes); + hb->size = num_bytes; + erts_current_bin = (byte *) hb->data; + new_binary = make_binary(hb); + + do_bits_sub_bin: + if (num_bits & 7) { + ErlSubBin* sb; + + sb = (ErlSubBin *) HTOP; + HTOP += ERL_SUB_BIN_SIZE; + sb->thing_word = HEADER_SUB_BIN; + sb->size = num_bytes - 1; + sb->bitsize = num_bits & 7; + sb->offs = 0; + sb->bitoffs = 0; + sb->is_writable = 0; + sb->orig = new_binary; + new_binary = make_binary(sb); + } + HEAP_SPACE_VERIFIED(0); + $Dst = new_binary; + } else { + Binary* bptr; + ProcBin* pb; + + erts_bin_offset = 0; + erts_writable_bin = 0; + + /* + * Allocate the binary struct itself. + */ + bptr = erts_bin_nrml_alloc(num_bytes); + erts_current_bin = (byte *) bptr->orig_bytes; + + /* + * Now allocate the ProcBin on the heap. + */ + pb = (ProcBin *) HTOP; + HTOP += PROC_BIN_SIZE; + pb->thing_word = HEADER_PROC_BIN; + pb->size = num_bytes; + pb->next = MSO(c_p).first; + MSO(c_p).first = (struct erl_off_heap_header*) pb; + pb->val = bptr; + pb->bytes = (byte*) bptr->orig_bytes; + pb->flags = 0; + OH_OVERHEAD(&(MSO(c_p)), pb->size / sizeof(Eterm)); + new_binary = make_binary(pb); + goto do_bits_sub_bin; + } +} + +bs_add(Fail, Src1, Src2, Unit, Dst) { + Eterm Op1 = $Src1; + Eterm Op2 = $Src2; + Uint unit = $Unit; + + if (is_both_small(Op1, Op2)) { + Sint Arg1 = signed_val(Op1); + Sint Arg2 = signed_val(Op2); + + if (Arg1 >= 0 && Arg2 >= 0) { + $BS_SAFE_MUL(Arg2, unit, $SYSTEM_LIMIT($Fail), Op1); + Op1 += Arg1; + + store_bs_add_result: + if (Op1 <= MAX_SMALL) { + Op1 = make_small(Op1); + } else { + /* + * May generate a heap fragment, but in this + * particular case it is OK, since the value will be + * stored into an x register (the GC will scan x + * registers for references to heap fragments) and + * there is no risk that value can be stored into a + * location that is not scanned for heap-fragment + * references (such as the heap). + */ + SWAPOUT; + Op1 = erts_make_integer(Op1, c_p); + HTOP = HEAP_TOP(c_p); + } + $Dst = Op1; + $NEXT0(); + } + $BADARG($Fail); + } else { + Uint a; + Uint b; + Uint c; + + /* + * Now we know that one of the arguments is + * not a small. We must convert both arguments + * to Uints and check for errors at the same time. + * + * Error checking is tricky. + * + * If one of the arguments is not numeric or + * not positive, the error reason is BADARG. + * + * Otherwise if both arguments are numeric, + * but at least one argument does not fit in + * an Uint, the reason is SYSTEM_LIMIT. + */ + + if (!term_to_Uint(Op1, &a)) { + if (a == BADARG) { + $BADARG($Fail); + } + if (!term_to_Uint(Op2, &b)) { + c_p->freason = b; + $FAIL_HEAD_OR_BODY($Fail); + } + $SYSTEM_LIMIT($Fail); + } else if (!term_to_Uint(Op2, &b)) { + c_p->freason = b; + $FAIL_HEAD_OR_BODY($Fail); + } + + /* + * The arguments are now correct and stored in a and b. + */ + + $BS_SAFE_MUL(b, unit, $SYSTEM_LIMIT($Fail), c); + Op1 = a + c; + if (Op1 < a) { + /* + * If the result is less than one of the + * arguments, there must have been an overflow. + */ + $SYSTEM_LIMIT($Fail); + } + goto store_bs_add_result; + } + /* No fallthrough */ + ASSERT(0); +} + +bs_put_string(Len, Ptr) { + erts_new_bs_put_string(ERL_BITS_ARGS_2((byte *) $Ptr, $Len)); +} + +i_bs_append(Fail, ExtraHeap, Live, Unit, Size, Dst) { + Uint live = $Live; + Uint res; + + HEAVY_SWAPOUT; + reg[live] = x(SCRATCH_X_REG); + res = erts_bs_append(c_p, reg, live, $Size, $ExtraHeap, $Unit); + HEAVY_SWAPIN; + if (is_non_value(res)) { + /* c_p->freason is already set (to BADARG or SYSTEM_LIMIT). */ + $FAIL_HEAD_OR_BODY($Fail); + } + $Dst = res; +} + +i_bs_private_append(Fail, Unit, Size, Src, Dst) { + Eterm res; + + res = erts_bs_private_append(c_p, $Src, $Size, $Unit); + if (is_non_value(res)) { + /* c_p->freason is already set (to BADARG or SYSTEM_LIMIT). */ + $FAIL_HEAD_OR_BODY($Fail); + } + $Dst = res; +} + +bs_init_writable() { + HEAVY_SWAPOUT; + r(0) = erts_bs_init_writable(c_p, r(0)); + HEAVY_SWAPIN; +} + +i_bs_utf8_size(Src, Dst) { + Eterm arg = $Src; + Eterm result; + + /* + * Calculate the number of bytes needed to encode the source + * operand to UTF-8. If the source operand is invalid (e.g. wrong + * type or range) we return a nonsense integer result (0 or 4). We + * can get away with that because we KNOW that bs_put_utf8 will do + * full error checking. + */ + + if (arg < make_small(0x80UL)) { + result = make_small(1); + } else if (arg < make_small(0x800UL)) { + result = make_small(2); + } else if (arg < make_small(0x10000UL)) { + result = make_small(3); + } else { + result = make_small(4); + } + $Dst = result; +} + +i_bs_put_utf8(Fail, Src) { + if (!erts_bs_put_utf8(ERL_BITS_ARGS_1($Src))) { + $BADARG($Fail); + } +} + +i_bs_utf16_size(Src, Dst) { + Eterm arg = $Src; + Eterm result = make_small(2); + + /* + * Calculate the number of bytes needed to encode the source + * operarand to UTF-16. If the source operand is invalid (e.g. wrong + * type or range) we return a nonsense integer result (2 or 4). We + * can get away with that because we KNOW that bs_put_utf16 will do + * full error checking. + */ + + if (arg >= make_small(0x10000UL)) { + result = make_small(4); + } + $Dst = result; +} + +bs_put_utf16(Fail, Flags, Src) { + if (!erts_bs_put_utf16(ERL_BITS_ARGS_2($Src, $Flags))) { + $BADARG($Fail); + } +} + +// Validate a value about to be stored in a binary. +i_bs_validate_unicode(Fail, Src) { + Eterm val = $Src; + + /* + * There is no need to untag the integer, but it IS necessary + * to make sure it is small (if the term is a bignum, it could + * slip through the test, and there is no further test that + * would catch it, since bit syntax construction silently masks + * too big numbers). + */ + if (is_not_small(val) || val > make_small(0x10FFFFUL) || + (make_small(0xD800UL) <= val && val <= make_small(0xDFFFUL))) { + $BADARG($Fail); + } +} + +// Validate a value that has been matched out. +i_bs_validate_unicode_retract(Fail, Src, Ms) { + /* + * There is no need to untag the integer, but it IS necessary + * to make sure it is small (a bignum pointer could fall in + * the valid range). + */ + + Eterm i = $Src; + if (is_not_small(i) || i > make_small(0x10FFFFUL) || + (make_small(0xD800UL) <= i && i <= make_small(0xDFFFUL))) { + Eterm ms = $Ms; /* Match context */ + ErlBinMatchBuffer* mb; + + /* Invalid value. Retract the position in the binary. */ + mb = ms_matchbuffer(ms); + mb->offset -= 32; + $BADARG($Fail); + } +} + + +// +// Matching of binaries. +// + +i_bs_start_match2 := bs_start_match.fetch.execute; + +bs_start_match.head() { + Uint slots; + Uint live; + Eterm header; + Eterm context; +} + +bs_start_match.fetch(Src) { + context = $Src; +} + +bs_start_match.execute(Fail, Live, Slots, Dst) { + if (!is_boxed(context)) { + $FAIL($Fail); + } + header = *boxed_val(context); + slots = $Slots; + live = $Live; + if (header_is_bin_matchstate(header)) { + ErlBinMatchState* ms = (ErlBinMatchState *) boxed_val(context); + Uint actual_slots = HEADER_NUM_SLOTS(header); + ms->save_offset[0] = ms->mb.offset; + if (actual_slots < slots) { + ErlBinMatchState* dst; + Uint live = $Live; + Uint wordsneeded = ERL_BIN_MATCHSTATE_SIZE(slots); + + $GC_TEST_PRESERVE(wordsneeded, live, context); + ms = (ErlBinMatchState *) boxed_val(context); + dst = (ErlBinMatchState *) HTOP; + *dst = *ms; + *HTOP = HEADER_BIN_MATCHSTATE(slots); + HTOP += wordsneeded; + HEAP_SPACE_VERIFIED(0); + $Dst = make_matchstate(dst); + } + } else if (is_binary_header(header)) { + Eterm result; + Uint wordsneeded = ERL_BIN_MATCHSTATE_SIZE(slots); + $GC_TEST_PRESERVE(wordsneeded, live, context); + HEAP_TOP(c_p) = HTOP; +#ifdef DEBUG + c_p->stop = E; /* Needed for checking in HeapOnlyAlloc(). */ +#endif + result = erts_bs_start_match_2(c_p, context, slots); + HTOP = HEAP_TOP(c_p); + HEAP_SPACE_VERIFIED(0); + if (is_non_value(result)) { + $FAIL($Fail); + } + $Dst = result; + } else { + $FAIL($Fail); + } +} + +bs_test_zero_tail2(Fail, Ctx) { + ErlBinMatchBuffer *_mb; + _mb = (ErlBinMatchBuffer*) ms_matchbuffer($Ctx); + if (_mb->size != _mb->offset) { + $FAIL($Fail); + } +} + +bs_test_tail_imm2(Fail, Ctx, Offset) { + ErlBinMatchBuffer *_mb; + _mb = ms_matchbuffer($Ctx); + if (_mb->size - _mb->offset != $Offset) { + $FAIL($Fail); + } +} + +bs_test_unit(Fail, Ctx, Unit) { + ErlBinMatchBuffer *_mb; + _mb = ms_matchbuffer($Ctx); + if ((_mb->size - _mb->offset) % $Unit) { + $FAIL($Fail); + } +} + +bs_test_unit8(Fail, Ctx) { + ErlBinMatchBuffer *_mb; + _mb = ms_matchbuffer($Ctx); + if ((_mb->size - _mb->offset) & 7) { + $FAIL($Fail); + } +} + +i_bs_get_integer_8(Ctx, Fail, Dst) { + Eterm _result; + ErlBinMatchBuffer* _mb = ms_matchbuffer($Ctx); + + if (_mb->size - _mb->offset < 8) { + $FAIL($Fail); + } + if (BIT_OFFSET(_mb->offset) != 0) { + _result = erts_bs_get_integer_2(c_p, 8, 0, _mb); + } else { + _result = make_small(_mb->base[BYTE_OFFSET(_mb->offset)]); + _mb->offset += 8; + } + $Dst = _result; +} + +i_bs_get_integer_16(Ctx, Fail, Dst) { + Eterm _result; + ErlBinMatchBuffer* _mb = ms_matchbuffer($Ctx); + + if (_mb->size - _mb->offset < 16) { + $FAIL($Fail); + } + if (BIT_OFFSET(_mb->offset) != 0) { + _result = erts_bs_get_integer_2(c_p, 16, 0, _mb); + } else { + _result = make_small(get_int16(_mb->base+BYTE_OFFSET(_mb->offset))); + _mb->offset += 16; + } + $Dst = _result; +} + +%if ARCH_64 +i_bs_get_integer_32(Ctx, Fail, Dst) { + Uint32 _integer; + ErlBinMatchBuffer* _mb = ms_matchbuffer($Ctx); + + if (_mb->size - _mb->offset < 32) { + $FAIL($Fail); + } + if (BIT_OFFSET(_mb->offset) != 0) { + _integer = erts_bs_get_unaligned_uint32(_mb); + } else { + _integer = get_int32(_mb->base + _mb->offset/8); } + _mb->offset += 32; + $Dst = make_small(_integer); +} +%endif + +i_bs_get_integer_imm := bs_get_integer.fetch.execute; +i_bs_get_integer_small_imm := bs_get_integer.fetch_small.execute; + +bs_get_integer.head() { + Eterm Ms, Sz; +} + +bs_get_integer.fetch(Ctx, Size, Live) { + Uint wordsneeded; + Ms = $Ctx; + Sz = $Size; + wordsneeded = 1+WSIZE(NBYTES(Sz)); + $GC_TEST_PRESERVE(wordsneeded, $Live, Ms); +} + +bs_get_integer.fetch_small(Ctx, Size) { + Ms = $Ctx; + Sz = $Size; +} + +bs_get_integer.execute(Fail, Flags, Dst) { + ErlBinMatchBuffer* mb; + Eterm result; + + mb = ms_matchbuffer(Ms); + LIGHT_SWAPOUT; + result = erts_bs_get_integer_2(c_p, Sz, $Flags, mb); + LIGHT_SWAPIN; + HEAP_SPACE_VERIFIED(0); + if (is_non_value(result)) { + $FAIL($Fail); + } + $Dst = result; +} + +i_bs_get_integer(Fail, Live, FlagsAndUnit, Ms, Sz, Dst) { + Uint flags; + Uint size; + Eterm ms; + ErlBinMatchBuffer* mb; + Eterm result; + + flags = $FlagsAndUnit; + ms = $Ms; + $BS_GET_FIELD_SIZE($Sz, (flags >> 3), $FAIL($Fail), size); + if (size >= SMALL_BITS) { + Uint wordsneeded; + /* Check bits size before potential gc. + * We do not want a gc and then realize we don't need + * the allocated space (i.e. if the op fails). + * + * Remember to re-acquire the matchbuffer after gc. + */ + + mb = ms_matchbuffer(ms); + if (mb->size - mb->offset < size) { + $FAIL($Fail); + } + wordsneeded = 1+WSIZE(NBYTES((Uint) size)); + $GC_TEST_PRESERVE(wordsneeded, $Live, ms); + } + mb = ms_matchbuffer(ms); + LIGHT_SWAPOUT; + result = erts_bs_get_integer_2(c_p, size, flags, mb); + LIGHT_SWAPIN; + HEAP_SPACE_VERIFIED(0); + if (is_non_value(result)) { + $FAIL($Fail); + } + $Dst = result; +} + +i_bs_get_utf8(Ctx, Fail, Dst) { + ErlBinMatchBuffer* mb = ms_matchbuffer($Ctx); + Eterm result = erts_bs_get_utf8(mb); + + if (is_non_value(result)) { + $FAIL($Fail); + } + $Dst = result; +} + +i_bs_get_utf16(Ctx, Fail, Flags, Dst) { + ErlBinMatchBuffer* mb = ms_matchbuffer($Ctx); + Eterm result = erts_bs_get_utf16(mb, $Flags); + + if (is_non_value(result)) { + $FAIL($Fail); + } + $Dst = result; +} + +bs_context_to_binary := ctx_to_bin.fetch.execute; +i_bs_get_binary_all_reuse := ctx_to_bin.fetch_bin.execute; + +ctx_to_bin.head() { + Eterm context; + ErlBinMatchBuffer* mb; + ErlSubBin* sb; + Uint size; + Uint offs; + Uint orig; + Uint hole_size; +} + +ctx_to_bin.fetch(Src) { + context = $Src; + if (is_boxed(context) && + header_is_bin_matchstate(*boxed_val(context))) { + ErlBinMatchState* ms; + ms = (ErlBinMatchState *) boxed_val(context); + mb = &ms->mb; + offs = ms->save_offset[0]; + size = mb->size - offs; + } else { + $NEXT0(); + } +} + +ctx_to_bin.fetch_bin(Src, Fail, Unit) { + context = $Src; + mb = ms_matchbuffer(context); + size = mb->size - mb->offset; + if (size % $Unit != 0) { + $FAIL($Fail); + } + offs = mb->offset; +} + +ctx_to_bin.execute() { + orig = mb->orig; + sb = (ErlSubBin *) boxed_val(context); + hole_size = 1 + header_arity(sb->thing_word) - ERL_SUB_BIN_SIZE; + sb->thing_word = HEADER_SUB_BIN; + sb->size = BYTE_OFFSET(size); + sb->bitsize = BIT_OFFSET(size); + sb->offs = BYTE_OFFSET(offs); + sb->bitoffs = BIT_OFFSET(offs); + sb->is_writable = 0; + sb->orig = orig; + if (hole_size) { + sb[1].thing_word = make_pos_bignum_header(hole_size-1); + } +} + +i_bs_match_string(Ctx, Fail, Bits, Ptr) { + byte* bytes = (byte *) $Ptr; + Uint bits = $Bits; + ErlBinMatchBuffer* mb; + Uint offs; + + mb = ms_matchbuffer($Ctx); + if (mb->size - mb->offset < bits) { + $FAIL($Fail); + } + offs = mb->offset & 7; + if (offs == 0 && (bits & 7) == 0) { + if (sys_memcmp(bytes, mb->base+(mb->offset>>3), bits>>3)) { + $FAIL($Fail); + } + } else if (erts_cmp_bits(bytes, 0, mb->base+(mb->offset>>3), mb->offset & 7, bits)) { + $FAIL($Fail); + } + mb->offset += bits; +} + +i_bs_save2(Src, Slot) { + ErlBinMatchState* _ms = (ErlBinMatchState*) boxed_val((Eterm) $Src); + _ms->save_offset[$Slot] = _ms->mb.offset; +} + +i_bs_restore2(Src, Slot) { + ErlBinMatchState* _ms = (ErlBinMatchState*) boxed_val((Eterm) $Src); + _ms->mb.offset = _ms->save_offset[$Slot]; } diff --git a/erts/emulator/beam/float_instrs.tab b/erts/emulator/beam/float_instrs.tab new file mode 100644 index 0000000000..3d4db77892 --- /dev/null +++ b/erts/emulator/beam/float_instrs.tab @@ -0,0 +1,88 @@ +// -*- c -*- +// +// %CopyrightBegin% +// +// Copyright Ericsson AB 2017. All Rights Reserved. +// +// Licensed under the Apache License, Version 2.0 (the "License"); +// you may not use this file except in compliance with the License. +// You may obtain a copy of the License at +// +// http://www.apache.org/licenses/LICENSE-2.0 +// +// Unless required by applicable law or agreed to in writing, software +// distributed under the License is distributed on an "AS IS" BASIS, +// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +// See the License for the specific language governing permissions and +// limitations under the License. +// +// %CopyrightEnd% +// + +LOAD_DOUBLE(Src, Dst) { + GET_DOUBLE($Src, *(FloatDef *) &$Dst); +} + +fload(Reg, Dst) { + $LOAD_DOUBLE($Reg, $Dst); +} + +fstore(Float, Dst) { + PUT_DOUBLE(*((FloatDef *) &$Float), HTOP); + $Dst = make_float(HTOP); + HTOP += FLOAT_SIZE_OBJECT; +} + +fconv(Src, Dst) { + Eterm src = $Src; + + if (is_small(src)) { + $Dst = (double) signed_val(src); + } else if (is_big(src)) { + if (big_to_double(src, &$Dst) < 0) { + $BADARITH0(); + } + } else if (is_float(src)) { + $LOAD_DOUBLE(src, $Dst); + } else { + $BADARITH0(); + } +} + +FLOAT_OP(Src1, OP, Src2, Dst) { + ERTS_NO_FPE_CHECK_INIT(c_p); + $Dst = $Src1 $OP $Src2; + ERTS_NO_FPE_ERROR(c_p, $Dst, $BADARITH0()); +} + +i_fadd(Src1, Src2, Dst) { + $FLOAT_OP($Src1, +, $Src2, $Dst); +} + +i_fsub(Src1, Src2, Dst) { + $FLOAT_OP($Src1, -, $Src2, $Dst); +} + +i_fmul(Src1, Src2, Dst) { + $FLOAT_OP($Src1, *, $Src2, $Dst); +} + +i_fdiv(Src1, Src2, Dst) { + $FLOAT_OP($Src1, /, $Src2, $Dst); +} + +i_fnegate(Src, Dst) { + ERTS_NO_FPE_CHECK_INIT(c_p); + $Dst = -$Src; + ERTS_NO_FPE_ERROR(c_p, $Dst, $BADARITH0()); +} + +%unless NO_FPE_SIGNALS +fclearerror() { + ERTS_FP_CHECK_INIT(c_p); +} + +i_fcheckerror() { + ERTS_FP_ERROR(c_p, freg[0].fd, $BADARITH0()); +} +%endif diff --git a/erts/emulator/beam/instrs.tab b/erts/emulator/beam/instrs.tab index ca0cb2f63d..d45da62d03 100644 --- a/erts/emulator/beam/instrs.tab +++ b/erts/emulator/beam/instrs.tab @@ -19,71 +19,86 @@ // %CopyrightEnd% // -// Macros only used to generate instructions. +// Stack manipulation instructions -FAIL(Fail) { - //| -no_prefetch - SET_I((BeamInstr *) $Fail); - Goto(*I); +allocate(NeedStack, Live) { + $AH($NeedStack, 0, $Live); } -JUMP(Fail) { - //| -no_next - SET_I((BeamInstr *) $Fail); - Goto(*I); +allocate_heap(NeedStack, NeedHeap, Live) { + $AH($NeedStack, $NeedHeap, $Live); } -GC_TEST(Ns, Nh, Live) { - unsigned need = $Nh + $Ns; - if (E - HTOP < need) { - SWAPOUT; - PROCESS_MAIN_CHK_LOCKS(c_p); - FCALLS -= erts_garbage_collect_nobump(c_p, need, reg, $Live, FCALLS); - ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); - PROCESS_MAIN_CHK_LOCKS(c_p); - SWAPIN; +allocate_init(NeedStack, Live, Y) { + $AH($NeedStack, 0, $Live); + make_blank($Y); +} + +allocate_zero(NeedStack, Live) { + Eterm* ptr; + int i = $NeedStack; + $AH(i, 0, $Live); + for (ptr = E + i; ptr > E; ptr--) { + make_blank(*ptr); } - HEAP_SPACE_VERIFIED($Nh); } -// Make sure that there are NeedStack + NeedHeap + 1 words available -// on the combined heap/stack segment, then allocates NeedHeap + 1 -// words on the stack and saves CP. -AH(NeedStack, NeedHeap, Live) { - unsigned needed = $NeedStack + 1; - $GC_TEST(needed, $NeedHeap, $Live); - E -= needed; - SAVE_CP(E); +allocate_heap_zero(NeedStack, NeedHeap, Live) { + Eterm* ptr; + int i = $NeedStack; + $AH(i, $NeedHeap, $Live); + for (ptr = E + i; ptr > E; ptr--) { + make_blank(*ptr); + } } -// Start of instruction listings +// This instruction is probably never used (because it is combined with a +// a return). However, a future compiler might for some reason emit a +// deallocate not followed by a return, and that should work. + +deallocate(Deallocate) { + //| -no_prefetch + SET_CP(c_p, (BeamInstr *) cp_val(*E)); + E = ADD_BYTE_OFFSET(E, $Deallocate); +} + +deallocate_return(Deallocate) { + //| -no_next + int words_to_pop = $Deallocate; + SET_I((BeamInstr *) cp_val(*E)); + E = ADD_BYTE_OFFSET(E, words_to_pop); + CHECK_TERM(x(0)); + DispatchReturn; +} + +move_deallocate_return(Src, Deallocate) { + x(0) = $Src; + $deallocate_return($Deallocate); +} // Call instructions -DO_CALL(CallDest, NextInstr) { +DISPATCH(CallDest) { //| -no_next - SET_CP(c_p, $NextInstr); SET_I((BeamInstr *) $CallDest); DTRACE_LOCAL_CALL(c_p, erts_code_to_codemfa(I)); Dispatch(); } i_call(CallDest) { - $DO_CALL($CallDest, $NEXT_INSTRUCTION); + SET_CP(c_p, $NEXT_INSTRUCTION); + $DISPATCH($CallDest); } move_call(Src, CallDest) { x(0) = $Src; - $DO_CALL($CallDest, $NEXT_INSTRUCTION); + SET_CP(c_p, $NEXT_INSTRUCTION); + $DISPATCH($CallDest); } i_call_last(CallDest, Deallocate) { - //| -no_next - RESTORE_CP(E); - E = ADD_BYTE_OFFSET(E, ($Deallocate)); - SET_I((BeamInstr *) $CallDest); - DTRACE_LOCAL_CALL(c_p, erts_code_to_codemfa(I)); - Dispatch(); + $deallocate($Deallocate); + $DISPATCH($CallDest); } move_call_last(Src, CallDest, Deallocate) { @@ -92,66 +107,202 @@ move_call_last(Src, CallDest, Deallocate) { } i_call_only(CallDest) { - //| -no_next - SET_I((BeamInstr *) $CallDest); - DTRACE_LOCAL_CALL(c_p, erts_code_to_codemfa(I)); - Dispatch(); + $DISPATCH($CallDest); } -move_call_only(Src, CallDest) { +i_move_call_only(CallDest, Src) { x(0) = $Src; $i_call_only($CallDest); } -// Other instructions +move_call_only(Src, CallDest) { + $i_move_call_only($CallDest, $Src); +} -allocate(NeedStack, Live) { - $AH($NeedStack, 0, $Live); +DISPATCHX(Dest) { + //| -no_next + DTRACE_GLOBAL_CALL_FROM_EXPORT(c_p, $Dest); + // Dispatchx assumes the Export* is in Arg(0) + I = (&$Dest) - 1; + Dispatchx(); } -allocate_heap(NeedStack, NeedHeap, Live) { - $AH($NeedStack, $NeedHeap, $Live); +i_call_ext(Dest) { + SET_CP(c_p, $NEXT_INSTRUCTION); + $DISPATCHX($Dest); } -allocate_init(NeedStack, Live, Y) { - $AH($NeedStack, 0, $Live); - make_blank($Y); +i_move_call_ext(Src, Dest) { + x(0) = $Src; + $i_call_ext($Dest); } -allocate_zero(NeedStack, Live) { - Eterm* ptr; - int i = $NeedStack; - $AH(i, 0, $Live); - for (ptr = E + i; ptr > E; ptr--) { - make_blank(*ptr); +i_call_ext_only(Dest) { + $DISPATCHX($Dest); +} + +i_move_call_ext_only(Dest, Src) { + x(0) = $Src; + $i_call_ext_only($Dest); +} + +i_call_ext_last(Dest, Deallocate) { + $deallocate($Deallocate); + $DISPATCHX($Dest); +} + +i_move_call_ext_last(Dest, StackOffset, Src) { + x(0) = $Src; + $i_call_ext_last($Dest, $StackOffset); +} + +APPLY(I, Deallocate) { + //| -no_next + HEAVY_SWAPOUT; + next = apply(c_p, r(0), x(1), x(2), reg, $I, $Deallocate); + HEAVY_SWAPIN; +} + +HANDLE_APPLY_ERROR() { + I = handle_error(c_p, I, reg, &bif_export[BIF_apply_3]->info.mfa); + goto post_error_handling; +} + +i_apply() { + BeamInstr *next; + $APPLY(NULL, 0); + if (next != NULL) { + $i_call(next); } + $HANDLE_APPLY_ERROR(); } -allocate_heap_zero(NeedStack, NeedHeap, Live) { - Eterm* ptr; - int i = $NeedStack; - $AH(i, $NeedHeap, $Live); - for (ptr = E + i; ptr > E; ptr--) { - make_blank(*ptr); +i_apply_last(Deallocate) { + BeamInstr *next; + $APPLY(I, $Deallocate); + if (next != NULL) { + $i_call_last(next, $Deallocate); } + $HANDLE_APPLY_ERROR(); } -// This instruction is probably never used (because it is combined with a -// a return). However, a future compiler might for some reason emit a -// deallocate not followed by a return, and that should work. +i_apply_only() { + BeamInstr *next; + $APPLY(I, 0); + if (next != NULL) { + $i_call_only(next); + } + $HANDLE_APPLY_ERROR(); +} -deallocate(Deallocate) { - //| -no_prefetch - RESTORE_CP(E); - E = ADD_BYTE_OFFSET(E, $Deallocate); +FIXED_APPLY(Arity, I, Deallocate) { + //| -no_next + HEAVY_SWAPOUT; + next = fixed_apply(c_p, reg, $Arity, $I, $Deallocate); + HEAVY_SWAPIN; } -deallocate_return(Deallocate) { +apply(Arity) { + BeamInstr *next; + $FIXED_APPLY($Arity, NULL, 0); + if (next != NULL) { + $i_call(next); + } + $HANDLE_APPLY_ERROR(); +} + +apply_last(Arity, Deallocate) { + BeamInstr *next; + $FIXED_APPLY($Arity, I, $Deallocate); + if (next != NULL) { + $i_call_last(next, $Deallocate); + } + $HANDLE_APPLY_ERROR(); +} + +APPLY_FUN() { + HEAVY_SWAPOUT; + next = apply_fun(c_p, r(0), x(1), reg); + HEAVY_SWAPIN; +} + +HANDLE_APPLY_FUN_ERROR() { + goto find_func_info; +} + +DISPATCH_FUN(I) { + SET_I($I); + Dispatchfun(); +} + +i_apply_fun() { + BeamInstr *next; + $APPLY_FUN(); + if (next != NULL) { + SET_CP(c_p, $NEXT_INSTRUCTION); + $DISPATCH_FUN(next); + } + $HANDLE_APPLY_FUN_ERROR(); +} + +i_apply_fun_last(Deallocate) { + BeamInstr *next; + $APPLY_FUN(); + if (next != NULL) { + $deallocate($Deallocate); + $DISPATCH_FUN(next); + } + $HANDLE_APPLY_FUN_ERROR(); +} + +i_apply_fun_only() { + BeamInstr *next; + $APPLY_FUN(); + if (next != NULL) { + $DISPATCH_FUN(next); + } + $HANDLE_APPLY_FUN_ERROR(); +} + +CALL_FUN(Fun) { //| -no_next - int words_to_pop = $Deallocate; - SET_I((BeamInstr *) cp_val(*E)); - E = ADD_BYTE_OFFSET(E, words_to_pop); - CHECK_TERM(x(0)); + HEAVY_SWAPOUT; + next = call_fun(c_p, $Fun, reg, THE_NON_VALUE); + HEAVY_SWAPIN; +} + +i_call_fun(Fun) { + BeamInstr *next; + $CALL_FUN($Fun); + if (next != NULL) { + SET_CP(c_p, $NEXT_INSTRUCTION); + $DISPATCH_FUN(next); + } + $HANDLE_APPLY_FUN_ERROR(); +} + +i_call_fun_last(Fun, Deallocate) { + BeamInstr *next; + $CALL_FUN($Fun); + if (next != NULL) { + $deallocate($Deallocate); + $DISPATCH_FUN(next); + } + $HANDLE_APPLY_FUN_ERROR(); +} + +return() { + SET_I(c_p->cp); + DTRACE_RETURN_FROM_PC(c_p); + + /* + * We must clear the CP to make sure that a stale value do not + * create a false module dependcy preventing code upgrading. + * It also means that we can use the CP in stack backtraces. + */ + c_p->cp = 0; + CHECK_TERM(r(0)); + HEAP_SPACE_VERIFIED(0); DispatchReturn; } @@ -213,6 +364,56 @@ i_get_tuple_element3(Src, Element, Dst) { dst[2] = E3; } +i_element := element_group.fetch.execute; + + +element_group.head() { + Eterm element_index; + Eterm element_tuple; +} + +element_group.fetch(Src) { + element_tuple = $Src; +} + +element_group.execute(Fail, Index, Dst) { + element_index = $Index; + if (is_small(element_index) && is_tuple(element_tuple)) { + Eterm* tp = tuple_val(element_tuple); + + if ((signed_val(element_index) >= 1) && + (signed_val(element_index) <= arityval(*tp))) { + $Dst = tp[signed_val(element_index)]; + $NEXT0(); + } + } + c_p->freason = BADARG; + $BIF_ERROR_ARITY_2($Fail, BIF_element_2, element_index, element_tuple); +} + +i_fast_element := fast_element_group.fetch.execute; + +fast_element_group.head() { + Eterm fast_element_tuple; +} + +fast_element_group.fetch(Src) { + fast_element_tuple = $Src; +} + +fast_element_group.execute(Fail, Index, Dst) { + if (is_tuple(fast_element_tuple)) { + Eterm* tp = tuple_val(fast_element_tuple); + Eterm pos = $Index; /* Untagged integer >= 1 */ + if (pos <= arityval(*tp)) { + $Dst = tp[pos]; + $NEXT0(); + } + } + c_p->freason = BADARG; + $BIF_ERROR_ARITY_2($Fail, BIF_element_2, make_small($Index), fast_element_tuple); +} + init(Y) { make_blank($Y); } @@ -250,12 +451,6 @@ move3(S1, D1, S2, D2, S3, D3) { $D3 = $S3; } -move_deallocate_return(Src, Deallocate) { - //| -no_next - x(0) = $Src; - $deallocate_return($Deallocate); -} - move_dup(Src, D1, D2) { $D1 = $D2 = $Src; } @@ -341,12 +536,35 @@ put_list(Hd, Tl, Dst) { HTOP += 2; } -i_put_tuple(Dst, Arity) { - //| -no_next +i_put_tuple := i_put_tuple.make.fill; + +i_put_tuple.make(Dst) { $Dst = make_tuple(HTOP); - pt_arity = $Arity; +} + +i_put_tuple.fill(Arity) { + Eterm* hp = HTOP; + Eterm arity = $Arity; + + //| -no_next + *hp++ = make_arityval(arity); I = $NEXT_INSTRUCTION; - goto do_put_tuple; + do { + Eterm term = *I++; + switch (loader_tag(term)) { + case LOADER_X_REG: + *hp++ = x(loader_x_reg_index(term)); + break; + case LOADER_Y_REG: + *hp++ = y(loader_y_reg_index(term)); + break; + default: + *hp++ = term; + break; + } + } while (--arity != 0); + HTOP = hp; + Goto(*I); } self(Dst) { @@ -413,9 +631,13 @@ is_nonempty_list_get_list(Fail, Src, Hd, Tl) { $get_list($Src, $Hd, $Tl); } +jump(Fail) { + $JUMP($Fail); +} + move_jump(Fail, Src) { x(0) = $Src; - $JUMP($Fail); + $jump($Fail); } // @@ -537,6 +759,7 @@ test_arity(Fail, Pointer, Arity) { $FAIL($Fail); } } + i_is_eq_exact_immed(Fail, X, Y) { if ($X != $Y) { $FAIL($Fail); @@ -555,12 +778,24 @@ is_eq_exact(Fail, X, Y) { } } +i_is_eq_exact_literal(Fail, Src, Literal) { + if (!eq($Src, $Literal)) { + $FAIL($Fail); + } +} + is_ne_exact(Fail, X, Y) { if (EQ($X, $Y)) { $FAIL($Fail); } } +i_is_ne_exact_literal(Fail, Src, Literal) { + if (eq($Src, $Literal)) { + $FAIL($Fail); + } +} + is_eq(Fail, X, Y) { CMP_EQ_ACTION($X, $Y, $FAIL($Fail)); } @@ -577,18 +812,98 @@ is_ge(Fail, X, Y) { CMP_GE_ACTION($X, $Y, $FAIL($Fail)); } -i_get_map_element(Fail, Src, Key, Dst) { - Eterm res = get_map_element($Src, $Key); - if (is_non_value(res)) { - $FAIL($Fail); +badarg(Fail) { + $BADARG($Fail); +} + +badmatch(Src) { + c_p->fvalue = $Src; + c_p->freason = BADMATCH; + goto find_func_info; +} + +case_end(Src) { + c_p->fvalue = $Src; + c_p->freason = EXC_CASE_CLAUSE; + goto find_func_info; +} + +if_end() { + c_p->freason = EXC_IF_CLAUSE; + goto find_func_info; + //| -no_next; +} + +system_limit(Fail) { + $SYSTEM_LIMIT($Fail); + //| -no_next; +} + +catch(Y, Fail) { + c_p->catches++; + $Y = $Fail; +} + +catch_end(Y) { + c_p->catches--; + make_blank($Y); + if (is_non_value(r(0))) { + c_p->fvalue = NIL; + if (x(1) == am_throw) { + r(0) = x(2); + } else { + if (x(1) == am_error) { + SWAPOUT; + x(2) = add_stacktrace(c_p, x(2), x(3)); + SWAPIN; + } + /* only x(2) is included in the rootset here */ + if (E - HTOP < 3) { + SWAPOUT; + PROCESS_MAIN_CHK_LOCKS(c_p); + FCALLS -= erts_garbage_collect_nobump(c_p, 3, reg+2, 1, FCALLS); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); + PROCESS_MAIN_CHK_LOCKS(c_p); + SWAPIN; + } + r(0) = TUPLE2(HTOP, am_EXIT, x(2)); + HTOP += 3; + } } - $Dst = res; + CHECK_TERM(r(0)); } -i_get_map_element_hash(Fail, Src, Key, Hx, Dst) { - Eterm res = get_map_element_hash($Src, $Key, $Hx); - if (is_non_value(res)) { - $FAIL($Fail); - } - $Dst = res; +try_end(Y) { + c_p->catches--; + make_blank($Y); + if (is_non_value(r(0))) { + c_p->fvalue = NIL; + r(0) = x(1); + x(1) = x(2); + x(2) = x(3); + } } + +try_case_end(Src) { + c_p->fvalue = $Src; + c_p->freason = EXC_TRY_CLAUSE; + goto find_func_info; + //| -no_next; +} + +i_raise() { + Eterm raise_trace = x(2); + Eterm raise_value = x(1); + struct StackTrace *s; + + c_p->fvalue = raise_value; + c_p->ftrace = raise_trace; + s = get_trace_from_exc(raise_trace); + if (s == NULL) { + c_p->freason = EXC_ERROR; + } else { + c_p->freason = PRIMARY_EXCEPTION(s->freason); + } + goto find_func_info; +} + diff --git a/erts/emulator/beam/macros.tab b/erts/emulator/beam/macros.tab new file mode 100644 index 0000000000..57015fac31 --- /dev/null +++ b/erts/emulator/beam/macros.tab @@ -0,0 +1,139 @@ +// -*- c -*- +// +// %CopyrightBegin% +// +// Copyright Ericsson AB 2017. All Rights Reserved. +// +// Licensed under the Apache License, Version 2.0 (the "License"); +// you may not use this file except in compliance with the License. +// You may obtain a copy of the License at +// +// http://www.apache.org/licenses/LICENSE-2.0 +// +// Unless required by applicable law or agreed to in writing, software +// distributed under the License is distributed on an "AS IS" BASIS, +// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +// See the License for the specific language governing permissions and +// limitations under the License. +// +// %CopyrightEnd% +// + +// +// Use if there is a garbage collection before storing to a +// general destination (either X or Y register). +// + +REFRESH_GEN_DEST() { + dst_ptr = REG_TARGET_PTR(dst); +} + +FAIL(Fail) { + //| -no_prefetch + SET_I((BeamInstr *) $Fail); + Goto(*I); +} + +JUMP(Fail) { + //| -no_next + SET_I((BeamInstr *) $Fail); + Goto(*I); +} + +GC_TEST(Ns, Nh, Live) { + Uint need = $Nh + $Ns; + if (E - HTOP < need) { + SWAPOUT; + PROCESS_MAIN_CHK_LOCKS(c_p); + FCALLS -= erts_garbage_collect_nobump(c_p, need, reg, $Live, FCALLS); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); + PROCESS_MAIN_CHK_LOCKS(c_p); + SWAPIN; + } + HEAP_SPACE_VERIFIED($Nh); +} + +GC_TEST_PRESERVE(NeedHeap, Live, PreserveTerm) { + Uint need = $NeedHeap; + if (E - HTOP < need) { + SWAPOUT; + reg[$Live] = $PreserveTerm; + PROCESS_MAIN_CHK_LOCKS(c_p); + FCALLS -= erts_garbage_collect_nobump(c_p, need, reg, $Live+1, FCALLS); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); + PROCESS_MAIN_CHK_LOCKS(c_p); + $PreserveTerm = reg[$Live]; + SWAPIN; + } + HEAP_SPACE_VERIFIED($Nh); +} + + +// Make sure that there are NeedStack + NeedHeap + 1 words available +// on the combined heap/stack segment, then allocates NeedHeap + 1 +// words on the stack and saves CP. +AH(NeedStack, NeedHeap, Live) { + unsigned needed = $NeedStack + 1; + $GC_TEST(needed, $NeedHeap, $Live); + E -= needed; + *E = make_cp(c_p->cp); + c_p->cp = 0; +} + +NEXT0() { + //| -no_next + SET_I((BeamInstr *) $NEXT_INSTRUCTION); + Goto(*I); +} + +NEXT(Addr) { + //| -no_next + SET_I((BeamInstr *) $Addr); + Goto(*I); +} + +FAIL_HEAD_OR_BODY(Fail) { + //| -no_prefetch + if ($Fail) { + $FAIL($Fail); + } + goto find_func_info; +} + +BADARG(Fail) { + c_p->freason = BADARG; + $FAIL_HEAD_OR_BODY($Fail); +} + +BADARITH0() { + c_p->freason = BADARITH; + goto find_func_info; +} + +SYSTEM_LIMIT(Fail) { + c_p->freason = SYSTEM_LIMIT; + $FAIL_HEAD_OR_BODY($Fail); +} + +BIF_ERROR_ARITY_1(Fail, BIF, Op1) { + //| -no_prefetch + if ($Fail) { + $FAIL($Fail); + } + reg[0] = $Op1; + SWAPOUT; + I = handle_error(c_p, I, reg, &bif_export[$BIF]->info.mfa); + goto post_error_handling; +} + +BIF_ERROR_ARITY_2(Fail, BIF, Op1, Op2) { + //| -no_prefetch + if ($Fail) { + $FAIL($Fail); + } + reg[0] = $Op1; + reg[1] = $Op2; + SWAPOUT; + I = handle_error(c_p, I, reg, &bif_export[$BIF]->info.mfa); + goto post_error_handling; +} diff --git a/erts/emulator/beam/map_instrs.tab b/erts/emulator/beam/map_instrs.tab new file mode 100644 index 0000000000..7f9346d029 --- /dev/null +++ b/erts/emulator/beam/map_instrs.tab @@ -0,0 +1,162 @@ +// -*- c -*- +// +// %CopyrightBegin% +// +// Copyright Ericsson AB 2017. All Rights Reserved. +// +// Licensed under the Apache License, Version 2.0 (the "License"); +// you may not use this file except in compliance with the License. +// You may obtain a copy of the License at +// +// http://www.apache.org/licenses/LICENSE-2.0 +// +// Unless required by applicable law or agreed to in writing, software +// distributed under the License is distributed on an "AS IS" BASIS, +// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +// See the License for the specific language governing permissions and +// limitations under the License. +// +// %CopyrightEnd% +// + +BADMAP(Fail, Map) { + c_p->freason = BADMAP; + c_p->fvalue = $Map; + $FAIL_HEAD_OR_BODY($Fail); +} + +new_map(Dst, Live, N) { + Eterm res; + + HEAVY_SWAPOUT; + res = new_map(c_p, reg, I-1); + HEAVY_SWAPIN; + $REFRESH_GEN_DEST(); + $Dst = res; + $NEXT($NEXT_INSTRUCTION+$N); +} + +i_new_small_map_lit(Dst, Live, Literal) { + Eterm res; + Uint n; + + HEAVY_SWAPOUT; + res = new_small_map_lit(c_p, reg, &n, I-1); + HEAVY_SWAPIN; + $REFRESH_GEN_DEST(); + $Dst = res; + $NEXT($NEXT_INSTRUCTION+n); +} + +i_get_map_element(Fail, Src, Key, Dst) { + Eterm res = get_map_element($Src, $Key); + if (is_non_value(res)) { + $FAIL($Fail); + } + $Dst = res; +} + +i_get_map_element_hash(Fail, Src, Key, Hx, Dst) { + Eterm res = get_map_element_hash($Src, $Key, $Hx); + if (is_non_value(res)) { + $FAIL($Fail); + } + $Dst = res; +} + +i_get_map_elements(Fail, Src, N) { + Eterm map; + BeamInstr *fs; + Uint sz, n; + + map = $Src; + + /* This instruction assumes Arg1 is a map, + * i.e. that it follows a test is_map if needed. + */ + + n = (Uint)$N / 3; + fs = $NEXT_INSTRUCTION; + + if (is_flatmap(map)) { + flatmap_t *mp; + Eterm *ks; + Eterm *vs; + + mp = (flatmap_t *)flatmap_val(map); + sz = flatmap_get_size(mp); + + if (sz == 0) { + $FAIL($Fail); + } + + ks = flatmap_get_keys(mp); + vs = flatmap_get_values(mp); + + while(sz) { + if (EQ((Eterm) fs[0], *ks)) { + PUT_TERM_REG(*vs, fs[1]); + n--; + fs += 3; + /* no more values to fetch, we are done */ + if (n == 0) { + $NEXT(fs); + } + } + ks++, sz--, vs++; + } + $FAIL($Fail); + } else { + const Eterm *v; + Uint32 hx; + ASSERT(is_hashmap(map)); + while(n--) { + hx = fs[2]; + ASSERT(hx == hashmap_make_hash((Eterm)fs[0])); + if ((v = erts_hashmap_get(hx, (Eterm)fs[0], map)) == NULL) { + $FAIL($Fail); + } + PUT_TERM_REG(*v, fs[1]); + fs += 3; + } + $NEXT(fs); + } +} + +update_map_assoc(Fail, Src, Dst, Live, N) { + Eterm res; + Eterm map; + + map = $Src; + HEAVY_SWAPOUT; + res = update_map_assoc(c_p, reg, map, I); + HEAVY_SWAPIN; + if (is_value(res)) { + $REFRESH_GEN_DEST(); + $Dst = res; + $NEXT($NEXT_INSTRUCTION+$N); + } else { + /* + * This can only happen if the code was compiled + * with the compiler in OTP 17. + */ + $BADMAP($Fail, map); + } +} + +update_map_exact(Fail, Src, Dst, Live, N) { + Eterm res; + Eterm map; + + map = $Src; + HEAVY_SWAPOUT; + res = update_map_exact(c_p, reg, map, I); + HEAVY_SWAPIN; + if (is_value(res)) { + $REFRESH_GEN_DEST(); + $Dst = res; + $NEXT($NEXT_INSTRUCTION+$N); + } else { + $FAIL_HEAD_OR_BODY($Fail); + } +} diff --git a/erts/emulator/beam/msg_instrs.tab b/erts/emulator/beam/msg_instrs.tab new file mode 100644 index 0000000000..509143268b --- /dev/null +++ b/erts/emulator/beam/msg_instrs.tab @@ -0,0 +1,382 @@ +// -*- c -*- +// +// %CopyrightBegin% +// +// Copyright Ericsson AB 2017. All Rights Reserved. +// +// Licensed under the Apache License, Version 2.0 (the "License"); +// you may not use this file except in compliance with the License. +// You may obtain a copy of the License at +// +// http://www.apache.org/licenses/LICENSE-2.0 +// +// Unless required by applicable law or agreed to in writing, software +// distributed under the License is distributed on an "AS IS" BASIS, +// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +// See the License for the specific language governing permissions and +// limitations under the License. +// +// %CopyrightEnd% +// + +// /* +// * Skeleton for receive statement: +// * +// * recv_mark L1 Optional +// * call make_ref/monitor Optional +// * ... +// * recv_set L1 Optional +// * L1: <-------------------+ +// * <-----------+ | +// * | | +// * loop_rec L2 ------+---+ | +// * ... | | | +// * remove_message | | | +// * jump L3 | | | +// * ... | | | +// * loop_rec_end L1 --+ | | +// * L2: <---------------+ | +// * wait L1 -------------------+ or wait_timeout +// * timeout +// * +// * L3: Code after receive... +// * +// */ + +recv_mark(Dest) { + /* + * Save the current position in message buffer and the + * the label for the loop_rec/2 instruction for the + * the receive statement. + */ + c_p->msg.mark = (BeamInstr *) $Dest; + c_p->msg.saved_last = c_p->msg.last; +} + +i_recv_set() { + /* + * If the mark is valid (points to the loop_rec/2 + * instruction that follows), we know that the saved + * position points to the first message that could + * possibly be matched out. + * + * If the mark is invalid, we do nothing, meaning that + * we will look through all messages in the message queue. + */ + if (c_p->msg.mark == (BeamInstr *) ($NEXT_INSTRUCTION)) { + c_p->msg.save = c_p->msg.saved_last; + } + /* Fall through to the loop_rec/2 instruction */ +} + +i_loop_rec(Dest) { + //| -no_prefetch + + /* + * Pick up the next message and place it in x(0). + * If no message, jump to a wait or wait_timeout instruction. + */ + + ErtsMessage* msgp; + + /* + * We need to disable GC while matching messages + * in the queue. This since messages with data outside + * the heap will be corrupted by a GC. + */ + ASSERT(!(c_p->flags & F_DELAY_GC)); + c_p->flags |= F_DELAY_GC; + +loop_rec__: + + PROCESS_MAIN_CHK_LOCKS(c_p); + + msgp = PEEK_MESSAGE(c_p); + + if (!msgp) { + erts_proc_lock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); + /* Make sure messages wont pass exit signals... */ + if (ERTS_PROC_PENDING_EXIT(c_p)) { + erts_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); + SWAPOUT; + c_p->flags &= ~F_DELAY_GC; + c_p->arity = 0; + goto do_schedule; /* Will be rescheduled for exit */ + } + ERTS_MSGQ_MV_INQ2PRIVQ(c_p); + msgp = PEEK_MESSAGE(c_p); + if (msgp) { + erts_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); + } else { + c_p->flags &= ~F_DELAY_GC; + SET_I((BeamInstr *) $Dest); + Goto(*I); /* Jump to a wait or wait_timeout instruction */ + } + } + if (is_non_value(ERL_MESSAGE_TERM(msgp))) { + SWAPOUT; /* erts_decode_dist_message() may write to heap... */ + if (!erts_decode_dist_message(c_p, ERTS_PROC_LOCK_MAIN, msgp, 0)) { + /* + * A corrupt distribution message that we weren't able to decode; + * remove it... + */ + /* No swapin should be needed */ + ASSERT(HTOP == c_p->htop && E == c_p->stop); + /* TODO: Add DTrace probe for this bad message situation? */ + UNLINK_MESSAGE(c_p, msgp); + msgp->next = NULL; + erts_cleanup_messages(msgp); + goto loop_rec__; + } + SWAPIN; + } + r(0) = ERL_MESSAGE_TERM(msgp); +} + +remove_message() { + //| -no_prefetch + + /* + * Remove a (matched) message from the message queue. + */ + + ErtsMessage* msgp; + PROCESS_MAIN_CHK_LOCKS(c_p); + + ERTS_CHK_MBUF_SZ(c_p); + + msgp = PEEK_MESSAGE(c_p); + + if (ERTS_PROC_GET_SAVED_CALLS_BUF(c_p)) { + save_calls(c_p, &exp_receive); + } + if (ERL_MESSAGE_TOKEN(msgp) == NIL) { +#ifdef USE_VM_PROBES + if (DT_UTAG(c_p) != NIL) { + if (DT_UTAG_FLAGS(c_p) & DT_UTAG_PERMANENT) { + SEQ_TRACE_TOKEN(c_p) = am_have_dt_utag; + } else { + DT_UTAG(c_p) = NIL; + SEQ_TRACE_TOKEN(c_p) = NIL; + } + } else { +#endif + SEQ_TRACE_TOKEN(c_p) = NIL; +#ifdef USE_VM_PROBES + } + DT_UTAG_FLAGS(c_p) &= ~DT_UTAG_SPREADING; +#endif + } else if (ERL_MESSAGE_TOKEN(msgp) != am_undefined) { + Eterm msg; + SEQ_TRACE_TOKEN(c_p) = ERL_MESSAGE_TOKEN(msgp); +#ifdef USE_VM_PROBES + if (ERL_MESSAGE_TOKEN(msgp) == am_have_dt_utag) { + if (DT_UTAG(c_p) == NIL) { + DT_UTAG(c_p) = ERL_MESSAGE_DT_UTAG(msgp); + } + DT_UTAG_FLAGS(c_p) |= DT_UTAG_SPREADING; + } else { +#endif + ASSERT(is_tuple(SEQ_TRACE_TOKEN(c_p))); + ASSERT(SEQ_TRACE_TOKEN_ARITY(c_p) == 5); + ASSERT(is_small(SEQ_TRACE_TOKEN_SERIAL(c_p))); + ASSERT(is_small(SEQ_TRACE_TOKEN_LASTCNT(c_p))); + ASSERT(is_small(SEQ_TRACE_TOKEN_FLAGS(c_p))); + ASSERT(is_pid(SEQ_TRACE_TOKEN_SENDER(c_p))); + c_p->seq_trace_lastcnt = unsigned_val(SEQ_TRACE_TOKEN_SERIAL(c_p)); + if (c_p->seq_trace_clock < unsigned_val(SEQ_TRACE_TOKEN_SERIAL(c_p))) { + c_p->seq_trace_clock = unsigned_val(SEQ_TRACE_TOKEN_SERIAL(c_p)); + } + msg = ERL_MESSAGE_TERM(msgp); + seq_trace_output(SEQ_TRACE_TOKEN(c_p), msg, SEQ_TRACE_RECEIVE, + c_p->common.id, c_p); +#ifdef USE_VM_PROBES + } +#endif + } +#ifdef USE_VM_PROBES + if (DTRACE_ENABLED(message_receive)) { + Eterm token2 = NIL; + DTRACE_CHARBUF(receiver_name, DTRACE_TERM_BUF_SIZE); + Sint tok_label = 0; + Sint tok_lastcnt = 0; + Sint tok_serial = 0; + + dtrace_proc_str(c_p, receiver_name); + token2 = SEQ_TRACE_TOKEN(c_p); + if (have_seqtrace(token2)) { + tok_label = signed_val(SEQ_TRACE_T_LABEL(token2)); + tok_lastcnt = signed_val(SEQ_TRACE_T_LASTCNT(token2)); + tok_serial = signed_val(SEQ_TRACE_T_SERIAL(token2)); + } + DTRACE6(message_receive, + receiver_name, size_object(ERL_MESSAGE_TERM(msgp)), + c_p->msg.len - 1, tok_label, tok_lastcnt, tok_serial); + } +#endif + UNLINK_MESSAGE(c_p, msgp); + JOIN_MESSAGE(c_p); + CANCEL_TIMER(c_p); + + erts_save_message_in_proc(c_p, msgp); + c_p->flags &= ~F_DELAY_GC; + + if (ERTS_IS_GC_DESIRED_INTERNAL(c_p, HTOP, E)) { + /* + * We want to GC soon but we leave a few + * reductions giving the message some time + * to turn into garbage. + */ + ERTS_VBUMP_LEAVE_REDS_INTERNAL(c_p, 5, FCALLS); + } + + ERTS_DBG_CHK_REDS(c_p, FCALLS); + ERTS_CHK_MBUF_SZ(c_p); + + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); + PROCESS_MAIN_CHK_LOCKS(c_p); +} + +loop_rec_end(Dest) { + //| -no_next + /* + * Advance the save pointer to the next message (the current + * message didn't match), then jump to the loop_rec instruction. + */ + + ASSERT(c_p->flags & F_DELAY_GC); + + SET_I((BeamInstr *) $Dest); + SAVE_MESSAGE(c_p); + if (FCALLS > 0 || FCALLS > neg_o_reds) { + FCALLS--; + goto loop_rec__; + } + + c_p->flags &= ~F_DELAY_GC; + c_p->i = I; + SWAPOUT; + c_p->arity = 0; + c_p->current = NULL; + goto do_schedule; +} + +timeout_locked() { + /* + * A timeout has occurred. Reset the save pointer so that the next + * receive statement will examine the first message first. + */ + + erts_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); + $timeout(); +} + +timeout() { + if (IS_TRACED_FL(c_p, F_TRACE_RECEIVE)) { + trace_receive(c_p, am_clock_service, am_timeout, NULL); + } + if (ERTS_PROC_GET_SAVED_CALLS_BUF(c_p)) { + save_calls(c_p, &exp_timeout); + } + c_p->flags &= ~F_TIMO; + JOIN_MESSAGE(c_p); +} + +TIMEOUT_VALUE() { + c_p->freason = EXC_TIMEOUT_VALUE; + goto find_func_info; +} + +i_wait_error_locked() { + erts_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); + $TIMEOUT_VALUE(); +} + +i_wait_error() { + $TIMEOUT_VALUE(); +} + +wait_timeout_unlocked_int := wait.lock.int.execute; +wait_timeout_locked_int := wait.int.execute; + +wait_timeout_unlocked := wait.lock.src.execute; +wait_timeout_locked := wait.src.execute; + +wait_unlocked := wait.lock.execute; +wait_locked := wait.unlocked.execute; + +wait.lock() { + erts_proc_lock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); +} + +wait.unlocked() { +} + +wait.int(Int) { + /* + * If we have already set the timer, we must NOT set it again. Therefore, + * we must test the F_INSLPQUEUE flag as well as the F_TIMO flag. + */ + if ((c_p->flags & (F_INSLPQUEUE | F_TIMO)) == 0) { + BeamInstr** pi = (BeamInstr **) c_p->def_arg_reg; + *pi = $NEXT_INSTRUCTION; + erts_set_proc_timer_uword(c_p, $Int); + } +} + +wait.src(Src) { + /* + * If we have already set the timer, we must NOT set it again. Therefore, + * we must test the F_INSLPQUEUE flag as well as the F_TIMO flag. + */ + if ((c_p->flags & (F_INSLPQUEUE | F_TIMO)) == 0) { + Eterm timeout_value = $Src; + if (timeout_value == make_small(0)) { + erts_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); + $NEXT0(); + } else if (timeout_value == am_infinity) { + c_p->flags |= F_TIMO; + } else { + int tres = erts_set_proc_timer_term(c_p, timeout_value); + if (tres == 0) { + /* + * The timer routiner will set c_p->i to the value in + * c_p->def_arg_reg[0]. Note that it is safe to use this + * location because there are no living x registers in + * a receive statement. + */ + BeamInstr** pi = (BeamInstr**) c_p->def_arg_reg; + *pi = $NEXT_INSTRUCTION; + } else { /* Wrong time */ + erts_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); + c_p->freason = EXC_TIMEOUT_VALUE; + goto find_func_info; + } + } + } +} + +// +// Prepare to wait indefinitely for a new message to arrive +// (or the time set above if falling through from above). +// When a new message arrives, control will be transferred +// the loop_rec instruction (at label L1). In case of +// of timeout, control will be transferred to the timeout +// instruction following the wait_timeout instruction. +// + +wait.execute(JumpTarget) { + c_p->i = (BeamInstr *) $JumpTarget; /* L1 */ + SWAPOUT; + c_p->arity = 0; + + if (!ERTS_PTMR_IS_TIMED_OUT(c_p)) { + erts_atomic32_read_band_relb(&c_p->state, + ~ERTS_PSFLG_ACTIVE); + } + ASSERT(!ERTS_PROC_IS_EXITING(c_p)); + erts_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); + c_p->current = NULL; + goto do_schedule; + //| -no_next +} diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab index 8c9034518b..fdc4506351 100644 --- a/erts/emulator/beam/ops.tab +++ b/erts/emulator/beam/ops.tab @@ -378,13 +378,15 @@ move r y loop_rec Fail x==0 | smp_mark_target_label(Fail) => i_loop_rec Fail -label L | wait_timeout Fail Src | smp_already_locked(L) => label L | i_wait_timeout_locked Fail Src -wait_timeout Fail Src => i_wait_timeout Fail Src -i_wait_timeout Fail Src=aiq => gen_literal_timeout(Fail, Src) -i_wait_timeout_locked Fail Src=aiq => gen_literal_timeout_locked(Fail, Src) +label L | wait_timeout Fail Src | smp_already_locked(L) => \ + label L | wait_timeout_locked Src Fail +wait_timeout Fail Src => wait_timeout_unlocked Src Fail + +wait_timeout_unlocked Fail Src=aiq => gen_literal_timeout(Fail, Src) +wait_timeout_locked Fail Src=aiq => gen_literal_timeout_locked(Fail, Src) label L | wait Fail | smp_already_locked(L) => label L | wait_locked Fail -wait Fail | smp() => wait_unlocked Fail +wait Fail => wait_unlocked Fail label L | timeout | smp_already_locked(L) => label L | timeout_locked @@ -393,13 +395,14 @@ timeout timeout_locked i_loop_rec f loop_rec_end f -wait f wait_locked f wait_unlocked f -i_wait_timeout f I -i_wait_timeout f s -i_wait_timeout_locked f I -i_wait_timeout_locked f s + +wait_timeout_unlocked_int I f +wait_timeout_unlocked s f +wait_timeout_locked_int I f +wait_timeout_locked s f + i_wait_error i_wait_error_locked @@ -967,10 +970,9 @@ node x node y %hot -i_fast_element j x I d -i_fast_element j y I d +i_fast_element xy j I d -i_element j xy s d +i_element xy j s d bif1 f b s d bif1_body b s d @@ -1060,7 +1062,10 @@ i_bs_get_integer_imm x I I f I x i_bs_get_integer f I I s s x i_bs_get_integer_8 x f x i_bs_get_integer_16 x f x -i_bs_get_integer_32 x f I x + +%if ARCH_64 +i_bs_get_integer_32 x f x +%endif # Fetching binaries from binaries. bs_get_binary2 Fail=f Ms=x Live=u Sz=sq Unit=u Flags=u Dst=d => \ @@ -1134,12 +1139,8 @@ i_bs_validate_unicode_retract j s s bs_init2 Fail Sz Words Regs Flags Dst | binary_too_big(Sz) => system_limit Fail -bs_init2 Fail Sz=u Words=u==0 Regs Flags Dst | should_gen_heap_bin(Sz) => \ - i_bs_init_heap_bin Sz Regs Dst bs_init2 Fail Sz=u Words=u==0 Regs Flags Dst => i_bs_init Sz Regs Dst -bs_init2 Fail Sz=u Words Regs Flags Dst | should_gen_heap_bin(Sz) => \ - i_bs_init_heap_bin_heap Sz Words Regs Dst bs_init2 Fail Sz=u Words Regs Flags Dst => \ i_bs_init_heap Sz Words Regs Dst @@ -1153,10 +1154,8 @@ i_bs_init_fail xy j I x i_bs_init_fail_heap s I j I x i_bs_init I I x -i_bs_init_heap_bin I I x i_bs_init_heap I I I x -i_bs_init_heap_bin_heap I I I x bs_init_bits Fail Sz=o Words Regs Flags Dst => system_limit Fail @@ -1254,8 +1253,6 @@ i_new_bs_put_binary_all j s I bs_put_string I I -%hot - # # New floating point instructions (R8). # @@ -1268,9 +1265,11 @@ fnegate p FR1 FR2 => i_fnegate FR1 FR2 fconv Arg=iqan Dst=l => move Arg x | fconv x Dst -fmove q l -fmove d l -fmove l d +fmove Arg=l Dst=d => fstore Arg Dst +fmove Arg=dq Dst=l => fload Arg Dst + +fstore l d +fload dq l fconv d l @@ -1282,10 +1281,15 @@ i_fnegate l l fclearerror | no_fpe_signals() => fcheckerror p | no_fpe_signals() => + +%unless NO_FPE_SIGNALS fcheckerror p => i_fcheckerror i_fcheckerror fclearerror +%endif + +%hot # # New apply instructions in R10B. @@ -1385,9 +1389,9 @@ gen_minus p Live Reg=d Int=i Dst | negation_is_small(Int) => \ # GCing arithmetic instructions. # -gen_plus Fail Live S1 S2 Dst => i_plus Fail Live S1 S2 Dst +gen_plus Fail Live S1 S2 Dst => i_plus S1 S2 Fail Live Dst -gen_minus Fail Live S1 S2 Dst => i_minus Fail Live S1 S2 Dst +gen_minus Fail Live S1 S2 Dst => i_minus S1 S2 Fail Live Dst gc_bif2 Fail Live u$bif:erlang:stimes/2 S1 S2 Dst => \ i_times Fail Live S1 S2 Dst @@ -1398,15 +1402,15 @@ gc_bif2 Fail Live u$bif:erlang:intdiv/2 S1 S2 Dst => \ i_int_div Fail Live S1 S2 Dst gc_bif2 Fail Live u$bif:erlang:rem/2 S1 S2 Dst => \ - i_rem Fail Live S1 S2 Dst + i_rem S1 S2 Fail Live Dst gc_bif2 Fail Live u$bif:erlang:bsl/2 S1 S2 Dst => \ - i_bsl Fail Live S1 S2 Dst + i_bsl S1 S2 Fail Live Dst gc_bif2 Fail Live u$bif:erlang:bsr/2 S1 S2 Dst => \ - i_bsr Fail Live S1 S2 Dst + i_bsr S1 S2 Fail Live Dst gc_bif2 Fail Live u$bif:erlang:band/2 S1 S2 Dst => \ - i_band Fail Live S1 S2 Dst + i_band S1 S2 Fail Live Dst gc_bif2 Fail Live u$bif:erlang:bor/2 S1 S2 Dst => \ i_bor Fail Live S1 S2 Dst @@ -1418,25 +1422,25 @@ gc_bif1 Fail I u$bif:erlang:bnot/1 Src Dst=d => i_int_bnot Fail Src I Dst i_increment rxy I I d -i_plus j I x xy d -i_plus j I s s d +i_plus x xy j I d +i_plus s s j I d -i_minus j I x x d -i_minus j I s s d +i_minus x x j I d +i_minus s s j I d i_times j I s s d i_m_div j I s s d i_int_div j I s s d -i_rem j I x x d -i_rem j I s s d +i_rem x x j I d +i_rem s s j I d -i_bsl j I s s d -i_bsr j I s s d +i_bsl s s j I d +i_bsr s s j I d -i_band j I x c d -i_band j I s s d +i_band x c j I d +i_band s s j I d i_bor j I s s d i_bxor j I s s d diff --git a/erts/emulator/beam/select_instrs.tab b/erts/emulator/beam/select_instrs.tab new file mode 100644 index 0000000000..e85ed2c304 --- /dev/null +++ b/erts/emulator/beam/select_instrs.tab @@ -0,0 +1,196 @@ +// -*- c -*- +// +// %CopyrightBegin% +// +// Copyright Ericsson AB 2017. All Rights Reserved. +// +// Licensed under the Apache License, Version 2.0 (the "License"); +// you may not use this file except in compliance with the License. +// You may obtain a copy of the License at +// +// http://www.apache.org/licenses/LICENSE-2.0 +// +// Unless required by applicable law or agreed to in writing, software +// distributed under the License is distributed on an "AS IS" BASIS, +// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +// See the License for the specific language governing permissions and +// limitations under the License. +// +// %CopyrightEnd% +// + +i_select_val_bins := select_val_bins.fetch.select; + +select_val_bins.head() { + Eterm select_val; +} + +select_val_bins.fetch(Src) { + select_val = $Src; +} + +select_val_bins.select(Fail, NumElements) { + struct Pairs { + BeamInstr val; + BeamInstr* addr; + }; + struct Pairs* low; + struct Pairs* high; + struct Pairs* mid; + int bdiff; /* int not long because the arrays aren't that large */ + + low = (struct Pairs *) (&$NumElements + 1); + high = low + $NumElements; + + /* The pointer subtraction (high-low) below must produce + * a signed result, because high could be < low. That + * requires the compiler to insert quite a bit of code. + * + * However, high will be > low so the result will be + * positive. We can use that knowledge to optimise the + * entire sequence, from the initial comparison to the + * computation of mid. + * + * -- Mikael Pettersson, Acumem AB + * + * Original loop control code: + * + * while (low < high) { + * mid = low + (high-low) / 2; + * + */ + while ((bdiff = (int)((char*)high - (char*)low)) > 0) { + unsigned int boffset = ((unsigned int)bdiff >> 1) & ~(sizeof(struct Pairs)-1); + + mid = (struct Pairs*)((char*)low + boffset); + if (select_val < mid->val) { + high = mid; + } else if (select_val > mid->val) { + low = mid + 1; + } else { + $NEXT(mid->addr); + } + } + $NEXT($Fail); +} + +i_select_tuple_arity2 := select_val2.src.ta_fail.execute; +i_select_val2 := select_val2.src.fail.execute; + +select_val2.head() { + Eterm select_val2; + BeamInstr* select_fail; +} + +select_val2.src(Src) { + select_val2 = $Src; +} + +select_val2.ta_fail(Fail) { + select_fail = &$Fail; + if (is_not_tuple(select_val2)) { + $FAIL(*select_fail); + } + select_val2 = *tuple_val(select_val2); +} + +select_val2.fail(Fail) { + select_fail = &$Fail; +} + +select_val2.execute(T1, T2, D1, D2) { + if (select_val2 == $T1) { + $JUMP($D1); + } else if (select_val2 == $T2) { + $JUMP($D2); + } else { + $FAIL(*select_fail); + } +} + +i_select_tuple_arity := select_val_lin.fetch.ta_fail.execute; +i_select_val_lins := select_val_lin.fetch.fail.execute; + +select_val_lin.head() { + Eterm select_val; + BeamInstr* select_fail; +} + +select_val_lin.fetch(Src) { + select_val = $Src; +} + +select_val_lin.ta_fail(Fail) { + select_fail = &$Fail; + if (is_tuple(select_val)) { + select_val = *tuple_val(select_val); + } else { + $JUMP(*select_fail); + } +} + +select_val_lin.fail(Fail) { + select_fail = &$Fail; +} + +select_val_lin.execute(N) { + BeamInstr* vs = $NEXT_INSTRUCTION; + int ix = 0; + + for (;;) { + if (vs[ix+0] >= select_val) { + ix += 0; + break; + } + if (vs[ix+1] >= select_val) { + ix += 1; + break; + } + ix += 2; + } + + if (vs[ix] == select_val) { + I = $NEXT_INSTRUCTION + $N + ix; + $JUMP(*I); + } else { + $JUMP(*select_fail); + } +} + +JUMP_ON_VAL(Fail, Index, N, Base) { + if (is_small($Index)) { + $Index = (Uint) (signed_val($Index) - $Base); + if ($Index < $N) { + $JUMP((($NEXT_INSTRUCTION)[$Index])); + } + } + $FAIL($Fail); +} + +i_jump_on_val_zero := jump_on_val_zero.fetch.execute; + +jump_on_val_zero.head() { + Eterm index; +} + +jump_on_val_zero.fetch(Src) { + index = $Src; +} + +jump_on_val_zero.execute(Fail, N) { + $JUMP_ON_VAL($Fail, index, $N, 0); +} + +i_jump_on_val := jump_on_val.fetch.execute; + +jump_on_val.head() { + Eterm index; +} + +jump_on_val.fetch(Src) { + index = $Src; +} + +jump_on_val.execute(Fail, N, Base) { + $JUMP_ON_VAL($Fail, index, $N, $Base); +} diff --git a/erts/emulator/beam/trace_instrs.tab b/erts/emulator/beam/trace_instrs.tab new file mode 100644 index 0000000000..dfd1d16d58 --- /dev/null +++ b/erts/emulator/beam/trace_instrs.tab @@ -0,0 +1,155 @@ +// -*- c -*- +// +// %CopyrightBegin% +// +// Copyright Ericsson AB 2017. All Rights Reserved. +// +// Licensed under the Apache License, Version 2.0 (the "License"); +// you may not use this file except in compliance with the License. +// You may obtain a copy of the License at +// +// http://www.apache.org/licenses/LICENSE-2.0 +// +// Unless required by applicable law or agreed to in writing, software +// distributed under the License is distributed on an "AS IS" BASIS, +// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +// See the License for the specific language governing permissions and +// limitations under the License. +// +// %CopyrightEnd% +// + +return_trace() { + ErtsCodeMFA* mfa = (ErtsCodeMFA *)(E[0]); + + SWAPOUT; /* Needed for shared heap */ + ERTS_UNREQ_PROC_MAIN_LOCK(c_p); + erts_trace_return(c_p, mfa, r(0), ERTS_TRACER_FROM_ETERM(E+1)/* tracer */); + ERTS_REQ_PROC_MAIN_LOCK(c_p); + SWAPIN; + c_p->cp = NULL; + SET_I((BeamInstr *) cp_val(E[2])); + E += 3; + Goto(*I); + //| -no_next +} + +i_generic_breakpoint() { + BeamInstr real_I; + HEAVY_SWAPOUT; + real_I = erts_generic_breakpoint(c_p, erts_code_to_codeinfo(I), reg); + HEAVY_SWAPIN; + ASSERT(VALID_INSTR(real_I)); + Goto(real_I); + //| -no_next +} + +i_return_time_trace() { + BeamInstr *pc = (BeamInstr *) (UWord) E[0]; + SWAPOUT; + erts_trace_time_return(c_p, erts_code_to_codeinfo(pc)); + SWAPIN; + c_p->cp = NULL; + SET_I((BeamInstr *) cp_val(E[1])); + E += 2; + Goto(*I); + //| -no_next +} + +i_return_to_trace() { + if (IS_TRACED_FL(c_p, F_TRACE_RETURN_TO)) { + Uint *cpp = (Uint*) E; + for(;;) { + ASSERT(is_CP(*cpp)); + if (*cp_val(*cpp) == (BeamInstr) OpCode(return_trace)) { + do + ++cpp; + while (is_not_CP(*cpp)); + cpp += 2; + } else if (*cp_val(*cpp) == (BeamInstr) OpCode(i_return_to_trace)) { + do + ++cpp; + while (is_not_CP(*cpp)); + } else { + break; + } + } + SWAPOUT; /* Needed for shared heap */ + ERTS_UNREQ_PROC_MAIN_LOCK(c_p); + erts_trace_return_to(c_p, cp_val(*cpp)); + ERTS_REQ_PROC_MAIN_LOCK(c_p); + SWAPIN; + } + c_p->cp = NULL; + SET_I((BeamInstr *) cp_val(E[0])); + E += 1; + Goto(*I); + //| -no_next +} + +i_yield() { + /* This is safe as long as REDS_IN(c_p) is never stored + * in c_p->arg_reg[0]. It is currently stored in c_p->def_arg_reg[5]. + */ + c_p->arg_reg[0] = am_true; + c_p->arity = 1; /* One living register (the 'true' return value) */ + SWAPOUT; + c_p->i = $NEXT_INSTRUCTION; + c_p->current = NULL; + goto do_schedule; + //| -no_next +} + +i_hibernate() { + HEAVY_SWAPOUT; + if (erts_hibernate(c_p, r(0), x(1), x(2), reg)) { + FCALLS = c_p->fcalls; + c_p->flags &= ~F_HIBERNATE_SCHED; + goto do_schedule; + } else { + HEAVY_SWAPIN; + I = handle_error(c_p, I, reg, &bif_export[BIF_hibernate_3]->info.mfa); + goto post_error_handling; + } + //| -no_next +} + +// This is optimised as an instruction because +// it has to be very very fast. + +i_perf_counter() { + ErtsSysPerfCounter ts; + + ts = erts_sys_perf_counter(); + if (IS_SSMALL(ts)) { + r(0) = make_small((Sint)ts); + } else { + $GC_TEST(0, ERTS_SINT64_HEAP_SIZE(ts), 0); + r(0) = make_big(HTOP); +#if defined(ARCH_32) + if (ts >= (((Uint64) 1) << 32)) { + *HTOP = make_pos_bignum_header(2); + BIG_DIGIT(HTOP, 0) = (Uint) (ts & ((Uint) 0xffffffff)); + BIG_DIGIT(HTOP, 1) = (Uint) ((ts >> 32) & ((Uint) 0xffffffff)); + HTOP += 3; + } + else +#endif + { + *HTOP = make_pos_bignum_header(1); + BIG_DIGIT(HTOP, 0) = (Uint) ts; + HTOP += 2; + } + } +} + +i_debug_breakpoint() { + HEAVY_SWAPOUT; + I = call_error_handler(c_p, erts_code_to_codemfa(I), reg, am_breakpoint); + HEAVY_SWAPIN; + if (I) { + Goto(*I); + } + goto handle_error; + //| -no_next +} diff --git a/erts/emulator/hipe/hipe_instrs.tab b/erts/emulator/hipe/hipe_instrs.tab new file mode 100644 index 0000000000..bcce196a1d --- /dev/null +++ b/erts/emulator/hipe/hipe_instrs.tab @@ -0,0 +1,141 @@ +// -*- c -*- +// +// %CopyrightBegin% +// +// Copyright Ericsson AB 2017. All Rights Reserved. +// +// Licensed under the Apache License, Version 2.0 (the "License"); +// you may not use this file except in compliance with the License. +// You may obtain a copy of the License at +// +// http://www.apache.org/licenses/LICENSE-2.0 +// +// Unless required by applicable law or agreed to in writing, software +// distributed under the License is distributed on an "AS IS" BASIS, +// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +// See the License for the specific language governing permissions and +// limitations under the License. +// +// %CopyrightEnd% +// + + +HIPE_MODE_SWITCH(Cmd) { + SWAPOUT; + ERTS_DBG_CHK_REDS(c_p, FCALLS); + c_p->fcalls = FCALLS; + c_p->def_arg_reg[4] = -neg_o_reds; + c_p = hipe_mode_switch(c_p, $Cmd, reg); +} + +hipe_trap_call := hipe_trap.call.post; +hipe_trap_call_closure := hipe_trap.call_closure.post; +hipe_trap_return := hipe_trap.return.post; +hipe_trap_throw := hipe_trap.throw.post; +hipe_trap_resume := hipe_trap.resume.post; + +hipe_trap.call() { + /* + * I[-5]: &&lb_i_func_info_IaaI + * I[-4]: Native code callee (inserted by HiPE) + * I[-3]: Module (tagged atom) + * I[-2]: Function (tagged atom) + * I[-1]: Arity (untagged integer) + * I[ 0]: &&lb_hipe_trap_call + * ... remainder of original BEAM code + */ + ErtsCodeInfo *ci = erts_code_to_codeinfo(I); + ASSERT(ci->op == (Uint) OpCode(i_func_info_IaaI)); + c_p->hipe.u.ncallee = ci->u.ncallee; + ++hipe_trap_count; + $HIPE_MODE_SWITCH(HIPE_MODE_SWITCH_CMD_CALL | (ci->mfa.arity << 8)); +} + +hipe_trap.call_closure() { + ErtsCodeInfo *ci = erts_code_to_codeinfo(I); + ASSERT(ci->op == (Uint) OpCode(i_func_info_IaaI)); + c_p->hipe.u.ncallee = ci->u.ncallee; + ++hipe_trap_count; + $HIPE_MODE_SWITCH(HIPE_MODE_SWITCH_CMD_CALL_CLOSURE | (ci->mfa.arity << 8)); +} + +hipe_trap.return() { + $HIPE_MODE_SWITCH(HIPE_MODE_SWITCH_CMD_RETURN); +} + +hipe_trap.throw() { + $HIPE_MODE_SWITCH(HIPE_MODE_SWITCH_CMD_THROW); +} + +hipe_trap.resume() { + $HIPE_MODE_SWITCH(HIPE_MODE_SWITCH_CMD_RESUME); +} + +hipe_trap.post() { +#ifdef DEBUG + pid = c_p->common.id; /* may have switched process... */ +#endif + reg = erts_proc_sched_data(c_p)->x_reg_array; + freg = erts_proc_sched_data(c_p)->f_reg_array; + ERL_BITS_RELOAD_STATEP(c_p); + /* XXX: this abuse of def_arg_reg[] is horrid! */ + neg_o_reds = -c_p->def_arg_reg[4]; + FCALLS = c_p->fcalls; + SWAPIN; + ERTS_DBG_CHK_REDS(c_p, FCALLS); + switch( c_p->def_arg_reg[3] ) { + case HIPE_MODE_SWITCH_RES_RETURN: + ASSERT(is_value(reg[0])); + SET_I(c_p->cp); + c_p->cp = 0; + Goto(*I); + case HIPE_MODE_SWITCH_RES_CALL_EXPORTED: + c_p->i = c_p->hipe.u.callee_exp->addressv[erts_active_code_ix()]; + /*fall through*/ + case HIPE_MODE_SWITCH_RES_CALL_BEAM: + SET_I(c_p->i); + Dispatch(); + case HIPE_MODE_SWITCH_RES_CALL_CLOSURE: + /* This can be used to call any function value, but currently + it's only used to call closures referring to unloaded + modules. */ + { + BeamInstr *next; + + next = call_fun(c_p, c_p->arity - 1, reg, THE_NON_VALUE); + HEAVY_SWAPIN; + if (next != NULL) { + SET_I(next); + Dispatchfun(); + } + goto find_func_info; + } + case HIPE_MODE_SWITCH_RES_THROW: + c_p->cp = NULL; + I = handle_error(c_p, I, reg, NULL); + goto post_error_handling; + default: + erts_exit(ERTS_ERROR_EXIT, "hipe_mode_switch: result %u\n", c_p->def_arg_reg[3]); + } + //| -no_next; +} + +hipe_call_count() { + /* + * I[-5]: &&lb_i_func_info_IaaI + * I[-4]: pointer to struct hipe_call_count (inserted by HiPE) + * I[-3]: Module (tagged atom) + * I[-2]: Function (tagged atom) + * I[-1]: Arity (untagged integer) + * I[ 0]: &&lb_hipe_call_count + * ... remainder of original BEAM code + */ + ErtsCodeInfo *ci = erts_code_to_codeinfo(I); + struct hipe_call_count *hcc = ci->u.hcc; + ASSERT(ci->op == (Uint) OpCode(i_func_info_IaaI)); + ASSERT(hcc != NULL); + ASSERT(VALID_INSTR(hcc->opcode)); + ++(hcc->count); + Goto(hcc->opcode); + //| -no_next; +} |