From 4ab349bd590403edb42bb8972f881b5921bf257f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Thu, 5 Oct 2017 10:50:11 +0200 Subject: macros.tab: Fix assertion in SET_I_REL() 9a50a5d5fc1 changed the update of I, but forgot to update the preceding assertion. --- erts/emulator/beam/macros.tab | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'erts') diff --git a/erts/emulator/beam/macros.tab b/erts/emulator/beam/macros.tab index 0d175a7ec6..e0b5f56b53 100644 --- a/erts/emulator/beam/macros.tab +++ b/erts/emulator/beam/macros.tab @@ -38,7 +38,7 @@ REFRESH_GEN_DEST() { // zero, except in a few bit syntax instructions.) SET_I_REL(Offset) { - ASSERT(VALID_INSTR(*(I + ($Offset)))); + ASSERT(VALID_INSTR(*(I + ($Offset) + $IP_ADJUSTMENT))); I += $Offset + $IP_ADJUSTMENT; } -- cgit v1.2.3 From 6c8c122c487f1a1417dd2a674c4da7e6dd52739c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 4 Oct 2017 13:22:41 +0200 Subject: ops.tab: Slightly optimize badmatch on a Y register --- erts/emulator/beam/ops.tab | 3 +++ 1 file changed, 3 insertions(+) (limited to 'erts') diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab index 75ff40606b..b7ef1f0599 100644 --- a/erts/emulator/beam/ops.tab +++ b/erts/emulator/beam/ops.tab @@ -1139,6 +1139,9 @@ bs_test_unit8 f x # An y register operand for bs_context_to_binary is rare, # but can happen because of inlining. +bs_context_to_binary Y=y | line L | badmatch Y => \ + move Y x | bs_context_to_binary x | line L | badmatch x + bs_context_to_binary Y=y => move Y x | bs_context_to_binary x bs_context_to_binary x -- cgit v1.2.3 From 15099d5752d99587b24e00335713af9d82f16c34 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Thu, 5 Oct 2017 12:37:11 +0200 Subject: beam_disasm: Correct printing of y registers --- erts/emulator/beam/beam_debug.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'erts') diff --git a/erts/emulator/beam/beam_debug.c b/erts/emulator/beam/beam_debug.c index 0f332da63f..d8303a651a 100644 --- a/erts/emulator/beam/beam_debug.c +++ b/erts/emulator/beam/beam_debug.c @@ -744,7 +744,7 @@ print_op(fmtfn_t to, void *to_arg, int op, int size, BeamInstr* addr) erts_print(to, to_arg, " x(%d)", loader_x_reg_index(ap[0])); break; case LOADER_Y_REG: - erts_print(to, to_arg, " x(%d)", loader_y_reg_index(ap[0])); + erts_print(to, to_arg, " y(%d)", loader_y_reg_index(ap[0]) - CP_SIZE); break; default: erts_print(to, to_arg, " %T", (Eterm) ap[0]); @@ -765,7 +765,7 @@ print_op(fmtfn_t to, void *to_arg, int op, int size, BeamInstr* addr) erts_print(to, to_arg, " x(%d)", loader_x_reg_index(ap[0])); break; case LOADER_Y_REG: - erts_print(to, to_arg, " x(%d)", loader_y_reg_index(ap[0])); + erts_print(to, to_arg, " y(%d)", loader_y_reg_index(ap[0]) - CP_SIZE); break; default: erts_print(to, to_arg, " %T", (Eterm) ap[0]); @@ -788,7 +788,7 @@ print_op(fmtfn_t to, void *to_arg, int op, int size, BeamInstr* addr) erts_print(to, to_arg, " x(%d)", loader_x_reg_index(ap[0])); break; case LOADER_Y_REG: - erts_print(to, to_arg, " y(%d)", loader_y_reg_index(ap[0])); + erts_print(to, to_arg, " y(%d)", loader_y_reg_index(ap[0]) - CP_SIZE); break; default: erts_print(to, to_arg, " %T", (Eterm) ap[0]); -- cgit v1.2.3 From e1c9772ffdacae4007209ac5a82758b8e0d3cec4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 3 Oct 2017 10:11:18 +0200 Subject: Move LD flags for hipe from Makefile.in to configure.in We want the flags to be available for other tests in configure.in. --- erts/configure.in | 14 ++++++++++++++ erts/emulator/Makefile.in | 11 +---------- 2 files changed, 15 insertions(+), 10 deletions(-) (limited to 'erts') diff --git a/erts/configure.in b/erts/configure.in index 9dec562f33..85e167b93b 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -2766,6 +2766,20 @@ if test X${enable_hipe} = Xyes && test X$ARCH = Xamd64; then LDFLAGS=$saved_LDFLAGS])])]) fi +if test X${enable_hipe} = Xyes; then + case $OPSYS in + linux) + ppcBEAMLDFLAGS="-Wl,-m,elf32ppc" + ppc64BEAMLDFLAGS="-Wl,-m,elf64ppc,-T,hipe/elf64ppc.x" + ;; + darwin) + amd64BEAMLDFLAGS="-pagezero_size 0x10000000" + ;; + esac + archVarName="${ARCH}BEAMLDFLAGS" + eval HIPEBEAMLDFLAGS=\$$archVarName +fi +AC_SUBST(HIPEBEAMLDFLAGS) if test X${enable_fp_exceptions} = Xauto ; then case $host_os in diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in index 915cad4e18..85ca145d9f 100644 --- a/erts/emulator/Makefile.in +++ b/erts/emulator/Makefile.in @@ -240,16 +240,7 @@ ARCH=@ARCH@ ultrasparcCFLAGS=-Wa,-xarch=v8plusa ARCHCFLAGS=$($(ARCH)CFLAGS) -ifdef HIPE_ENABLED -ifeq ($(OPSYS),linux) -ppcBEAMLDFLAGS=-Wl,-m,elf32ppc -ppc64BEAMLDFLAGS=-Wl,-m,elf64ppc,-T,hipe/elf64ppc.x -endif -ifeq ($(OPSYS),darwin) -amd64BEAMLDFLAGS=-pagezero_size 0x10000000 -endif -HIPEBEAMLDFLAGS=$($(ARCH)BEAMLDFLAGS) -endif +HIPEBEAMLDFLAGS=@HIPEBEAMLDFLAGS@ ERTS_BUILD_FALLBACK_POLL=@ERTS_BUILD_FALLBACK_POLL@ -- cgit v1.2.3 From 22d2a00aebf0eef878af95d8b7598adbfca06e7e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 19 Sep 2017 06:33:06 +0200 Subject: Use 32-bits pointers to C code On a 64-bit machine, we only need 32 bits to store a pointer to the C code that implements a BEAM instruction. Refactor the code to only use the lower 32 bits of each instruction word, and take care to preserve the high 32 bits. --- erts/configure.in | 33 +++++++++++++++++++++++++++++++++ erts/emulator/beam/beam_bp.c | 19 +++++++++++++------ erts/emulator/beam/beam_emu.c | 30 +++++++++++++++++++++--------- erts/emulator/beam/erl_vm.h | 11 ++++++++++- 4 files changed, 77 insertions(+), 16 deletions(-) (limited to 'erts') diff --git a/erts/configure.in b/erts/configure.in index 85e167b93b..508e99a415 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -3773,6 +3773,39 @@ dnl LM_FIND_EMU_CC +dnl +dnl Test whether code pointers are always short (32 bits). +dnl + +AC_MSG_CHECKING([whether the code model is small]) +saved_LDFLAGS="$LDFLAGS" +LDFLAGS="$LDFLAGS $HIPEBEAMLDFLAGS" +AC_TRY_RUN([ + #include + int main() { + if ((unsigned long long)&main < (1ull << 32)) { + exit(0); + } + exit(1); + } +], +erl_code_model_small=yes, +erl_code_model_small=no, +erl_code_model_small=no) +AC_MSG_RESULT([$erl_code_model_small]) +LDFLAGS="$saved_LDFLAGS" +case $erl_code_model_small in + yes) + AC_DEFINE(CODE_MODEL_SMALL,[1], + [Define if the code model is small (code fits below 2Gb)]) + CODE_MODEL=small + ;; + no) + CODE_MODEL=unknown + ;; +esac +AC_SUBST(CODE_MODEL) + dnl dnl DTrace & LTTNG dnl diff --git a/erts/emulator/beam/beam_bp.c b/erts/emulator/beam/beam_bp.c index c81380c14d..871670e8c3 100644 --- a/erts/emulator/beam/beam_bp.c +++ b/erts/emulator/beam/beam_bp.c @@ -419,9 +419,11 @@ erts_install_breakpoints(BpFunctions* f) for (i = 0; i < n; i++) { ErtsCodeInfo* ci = f->matching[i].ci; - BeamInstr *pc = erts_codeinfo_to_code(ci); GenericBp* g = ci->u.gen_bp; - if (*pc != br && g) { + BeamInstr volatile *pc = erts_codeinfo_to_code(ci); + BeamInstr instr = *pc; + + if (!BeamIsOpCode(instr, op_i_generic_breakpoint) && g) { Module* modp = f->matching[i].mod; /* @@ -435,11 +437,16 @@ erts_install_breakpoints(BpFunctions* f) /* * The following write is not protected by any lock. We * assume that the hardware guarantees that a write of an - * aligned word-size (or half-word) writes is atomic - * (i.e. that other processes executing this code will not - * see a half pointer). + * aligned word-size writes is atomic (i.e. that other + * processes executing this code will not see a half + * pointer). + * + * The contents of *pc is marked 'volatile' to ensure that + * the compiler will do a single full-word write, and not + * try any fancy optimizations to write a half word. */ - *pc = br; + instr = BeamSetCodeAddr(instr, br); + *pc = instr; modp->curr.num_breakpoints++; } } diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 9a77c63390..6a45087a34 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -50,14 +50,14 @@ #if defined(NO_JUMP_TABLE) # define OpCase(OpCode) case op_##OpCode # define CountCase(OpCode) case op_count_##OpCode -# define IsOpCode(InstrWord, OpCode) ((InstrWord) == (BeamInstr)op_##OpCode) -# define Goto(Rel) {Go = (Rel); goto emulator_loop;} +# define IsOpCode(InstrWord, OpCode) (BeamCodeAddr(InstrWord) == (BeamInstr)op_##OpCode) +# define Goto(Rel) {Go = BeamCodeAddr(Rel); goto emulator_loop;} #else # define OpCase(OpCode) lb_##OpCode # define CountCase(OpCode) lb_count_##OpCode -# define IsOpCode(InstrWord, OpCode) ((InstrWord) == (BeamInstr)&&lb_##OpCode) -# define Goto(Rel) goto *((void *)Rel) -# define LabelAddr(Label) &&Label +# define IsOpCode(InstrWord, OpCode) (BeamCodeAddr(InstrWord) == (BeamInstr)&&lb_##OpCode) +# define Goto(Rel) goto *((void *)BeamCodeAddr(Rel)) +# define LabelAddr(Label) &&Label #endif #ifdef ERTS_ENABLE_LOCK_CHECK @@ -131,11 +131,11 @@ do { \ /* We don't check the range if an ordinary switch is used */ #ifdef NO_JUMP_TABLE -#define VALID_INSTR(IP) ((UWord)(IP) < (NUMBER_OF_OPCODES*2+10)) +# define VALID_INSTR(IP) (BeamCodeAddr(IP) < (NUMBER_OF_OPCODES*2+10)) #else -#define VALID_INSTR(IP) \ - ((SWord)LabelAddr(emulator_loop) <= (SWord)(IP) && \ - (SWord)(IP) < (SWord)LabelAddr(end_emulator_loop)) +# define VALID_INSTR(IP) \ + ((BeamInstr)LabelAddr(emulator_loop) <= BeamCodeAddr(IP) && \ + BeamCodeAddr(IP) < (BeamInstr)LabelAddr(end_emulator_loop)) #endif /* NO_JUMP_TABLE */ #define SET_CP(p, ip) \ @@ -1006,6 +1006,18 @@ init_emulator_finish(void) int i; Export* ep; +#if defined(ARCH_64) && defined(CODE_MODEL_SMALL) + for (i = 0; i < NUMBER_OF_OPCODES; i++) { + BeamInstr instr = BeamOpCodeAddr(i); + if (instr >= (1ull << 32)) { + erts_exit(ERTS_ERROR_EXIT, + "This run-time was supposed be compiled with all code below 2Gb,\n" + "but the instruction '%s' is located at %016lx.\n", + opc[i].name, instr); + } + } +#endif + beam_apply[0] = BeamOpCodeAddr(op_i_apply); beam_apply[1] = BeamOpCodeAddr(op_normal_exit); beam_exit[0] = BeamOpCodeAddr(op_error_action_code); diff --git a/erts/emulator/beam/erl_vm.h b/erts/emulator/beam/erl_vm.h index 661538eadd..76980b5871 100644 --- a/erts/emulator/beam/erl_vm.h +++ b/erts/emulator/beam/erl_vm.h @@ -209,6 +209,15 @@ extern void** beam_ops; # define BeamOpCodeAddr(OpCode) ((BeamInstr)beam_ops[(OpCode)]) #endif -#define BeamIsOpCode(InstrWord, OpCode) ((InstrWord) == BeamOpCodeAddr(OpCode)) +#if defined(ARCH_64) && defined(CODE_MODEL_SMALL) +# define BeamCodeAddr(InstrWord) ((BeamInstr)(Uint32)(InstrWord)) +# define BeamSetCodeAddr(InstrWord, Addr) (((InstrWord) & ~((1ull << 32)-1)) | (Addr)) +# define BeamExtraData(InstrWord) ((InstrWord) >> 32) +#else +# define BeamCodeAddr(InstrWord) ((BeamInstr)(InstrWord)) +# define BeamSetCodeAddr(InstrWord, Addr) (Addr) +#endif + +#define BeamIsOpCode(InstrWord, OpCode) (BeamCodeAddr(InstrWord) == BeamOpCodeAddr(OpCode)) #endif /* __ERL_VM_H__ */ -- cgit v1.2.3 From f88bd45a2c76f84a16b004922945579898cc35ac Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 19 Sep 2017 11:56:45 +0200 Subject: Pack operands into the instruction word On 64-bit machines where the C code is always at address below 4Gb, pack one or more operands into the instruction word. --- erts/emulator/Makefile.in | 1 + erts/emulator/beam/beam_debug.c | 38 +++-- erts/emulator/beam/beam_emu.c | 7 +- erts/emulator/beam/beam_load.c | 43 +++++- erts/emulator/utils/beam_makeops | 304 +++++++++++++++++++++++++++------------ 5 files changed, 283 insertions(+), 110 deletions(-) (limited to 'erts') diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in index 85ca145d9f..54d45dce50 100644 --- a/erts/emulator/Makefile.in +++ b/erts/emulator/Makefile.in @@ -569,6 +569,7 @@ $(TTF_DIR)/beam_tr_funcs.h \ $(TTF_DIR)/OPCODES-GENERATED: $(OPCODE_TABLES) utils/beam_makeops $(gen_verbose)LANG=C $(PERL) utils/beam_makeops \ -wordsize @EXTERNAL_WORD_SIZE@ \ + -code-model @CODE_MODEL@ \ -outdir $(TTF_DIR) \ -DUSE_VM_PROBES=$(if $(USE_VM_PROBES),1,0) \ -DNO_FPE_SIGNALS=$(if $filter(unreliable,$(FPE)),1,0) \ diff --git a/erts/emulator/beam/beam_debug.c b/erts/emulator/beam/beam_debug.c index d8303a651a..70078c8c59 100644 --- a/erts/emulator/beam/beam_debug.c +++ b/erts/emulator/beam/beam_debug.c @@ -201,7 +201,7 @@ void debug_dump_code(BeamInstr *I, int num) for (i = 0; i < NUM_SPECIFIC_OPS; i++) { if (BeamIsOpCode(instr, i) && opc[i].name[0] != '\0') { code_ptr += print_op(ERTS_PRINT_DSBUF, (void *) dsbufp, - i, opc[i].sz-1, code_ptr+1) + 1; + i, opc[i].sz-1, code_ptr) + 1; break; } } @@ -321,7 +321,7 @@ erts_debug_disassemble_1(BIF_ALIST_1) for (i = 0; i < NUM_SPECIFIC_OPS; i++) { if (BeamIsOpCode(instr, i) && opc[i].name[0] != '\0') { code_ptr += print_op(ERTS_PRINT_DSBUF, (void *) dsbufp, - i, opc[i].sz-1, code_ptr+1) + 1; + i, opc[i].sz-1, code_ptr) + 1; break; } } @@ -405,8 +405,11 @@ print_op(fmtfn_t to, void *to_arg, int op, int size, BeamInstr* addr) * Avoid copying because instructions containing bignum operands * are bigger than actually declared. */ - ap = (BeamInstr *) addr; + addr++; + ap = addr; } else { + BeamInstr instr_word = addr++[0]; + /* * Copy all arguments to a local buffer for the unpacking. */ @@ -431,23 +434,22 @@ print_op(fmtfn_t to, void *to_arg, int op, int size, BeamInstr* addr) case 'q': *ap++ = *--sp; break; - case 'i': /* Initialize packing accumulator. */ - *ap++ = packed; - break; - case 's': - *ap++ = packed & 0x3ff; - packed >>= 10; +#ifdef ARCH_64 + case '1': /* Tightest shift */ + *ap++ = (packed & BEAM_TIGHTEST_MASK) << 3; + packed >>= BEAM_TIGHTEST_SHIFT; break; - case '0': /* Tight shift */ +#endif + case '2': /* Tight shift */ *ap++ = packed & BEAM_TIGHT_MASK; packed >>= BEAM_TIGHT_SHIFT; break; - case '6': /* Shift 16 steps */ + case '3': /* Loose shift */ *ap++ = packed & BEAM_LOOSE_MASK; packed >>= BEAM_LOOSE_SHIFT; break; #ifdef ARCH_64 - case 'w': /* Shift 32 steps */ + case '4': /* Shift 32 steps */ *ap++ = packed & BEAM_WIDE_MASK; packed >>= BEAM_WIDE_SHIFT; break; @@ -458,8 +460,18 @@ print_op(fmtfn_t to, void *to_arg, int op, int size, BeamInstr* addr) case 'P': packed = *--sp; break; +#if defined(ARCH_64) && defined(CODE_MODEL_SMALL) + case '#': /* -1 */ + case '$': /* -2 */ + case '%': /* -3 */ + case '&': /* -4 */ + case '\'': /* -5 */ + case '(': /* -6 */ + packed = (packed << BEAM_WIDE_SHIFT) | BeamExtraData(instr_word); + break; +#endif default: - ASSERT(0); + erts_exit(ERTS_ERROR_EXIT, "beam_debug: invalid packing op: %c\n", *prog); } } ap = args; diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 6a45087a34..73c4e3532b 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -234,15 +234,18 @@ void** beam_ops; #define fb(N) ((Sint)(Sint32)(N)) #define jb(N) ((Sint)(Sint32)(N)) #define tb(N) (N) -#define xb(N) (*(Eterm *) (((unsigned char *)reg) + (N))) -#define yb(N) (*(Eterm *) (((unsigned char *)E) + (N))) +#define xb(N) (*ADD_BYTE_OFFSET(reg, N)) +#define yb(N) (*ADD_BYTE_OFFSET(E, N)) #define Sb(N) (*REG_TARGET_PTR(N)) #define lb(N) (*(double *) (((unsigned char *)&(freg[0].fd)) + (N))) #define Qb(N) (N) #define Ib(N) (N) + #define x(N) reg[N] #define y(N) E[N] #define r(N) x(N) +#define Q(N) (N*sizeof(Eterm *)) +#define l(N) (freg[N].fd) /* * Check that we haven't used the reductions and jump to function pointed to by diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index 9835b1c096..00dd28b26c 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -2578,23 +2578,31 @@ load_code(LoaderState* stp) sp++; } break; - case 'i': /* Initialize packing accumulator. */ - packed = code[--ci]; +#ifdef ARCH_64 + case '1': /* Tightest shift (always 10 bits) */ + ci--; + ASSERT((code[ci] & ~0x1FF8ull) == 0); /* Fits in 10 bits */ + packed = (packed << BEAM_TIGHTEST_SHIFT); + packed |= code[ci] >> 3; + if (packed_label) { + packed_label->packed++; + } break; - case '0': /* Tight shift */ +#endif + case '2': /* Tight shift (10 or 16 bits) */ packed = (packed << BEAM_TIGHT_SHIFT) | code[--ci]; if (packed_label) { packed_label->packed++; } break; - case '6': /* Shift 16 steps */ + case '3': /* Loose shift (16 bits) */ packed = (packed << BEAM_LOOSE_SHIFT) | code[--ci]; if (packed_label) { packed_label->packed++; } break; #ifdef ARCH_64 - case 'w': /* Shift 32 steps */ + case '4': /* Wide shift (32 bits) */ { Uint w = code[--ci]; @@ -2646,8 +2654,31 @@ load_code(LoaderState* stp) sp++; packed = 0; break; +#if defined(ARCH_64) && defined(CODE_MODEL_SMALL) + case '#': /* -1 */ + case '$': /* -2 */ + case '%': /* -3 */ + case '&': /* -4 */ + case '\'': /* -5 */ + case '(': /* -6 */ + /* Pack accumulator contents into instruction word. */ + { + Sint pos = ci - (*prog - '#' + 1); + /* Are the high 32 bits of the instruction word zero? */ + ASSERT((code[pos] & ~((1ull << BEAM_WIDE_SHIFT)-1)) == 0); + code[pos] |= packed << BEAM_WIDE_SHIFT; + if (packed_label) { + ASSERT(packed_label->packed == 1); + packed_label->pos = pos; + packed_label->packed = 2; + packed_label = 0; + } + packed >>= BEAM_WIDE_SHIFT; + } + break; +#endif default: - ASSERT(0); + erts_exit(ERTS_ERROR_EXIT, "beam_load: invalid packing op: %c\n", *prog); } } ASSERT(sp == stack); /* Incorrect program? */ diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops index 64a9a49ac8..388e3d164d 100755 --- a/erts/emulator/utils/beam_makeops +++ b/erts/emulator/utils/beam_makeops @@ -24,6 +24,16 @@ use constant COLD => 0; use constant WARM => 1; use constant HOT => 2; +# Instructions for packing +use constant PACK_JUMP => 1; +use constant PACK_IN_INSTR_WORD => 2; + +# Packing commands +use constant PACK_CMD_TIGHTEST => '1'; +use constant PACK_CMD_TIGHT => '2'; +use constant PACK_CMD_LOOSE => '3'; +use constant PACK_CMD_WIDE => '4'; + $BEAM_FORMAT_NUMBER = undef; my $target = \&emulator_output; @@ -32,30 +42,15 @@ my $verbose = 0; my $hotness = 1; my $num_file_opcodes = 0; my $wordsize = 32; -my %defs; # Defines (from command line). +my $code_pointers_are_short = 0; # Whether code pointers (to C code) are short. +my $code_model = 'unknown'; +my %defs; # Defines (from command line). # This is shift counts and mask for the packer. my $WHOLE_WORD = ''; -my @pack_instr; -my @pack_shift; -my @pack_mask; - -$pack_instr[2] = ['6', 'i']; -$pack_instr[3] = ['0', '0', 'i']; -$pack_instr[4] = ['6', '6', '6', 'i']; # Only for 64 bit wordsize - -$pack_shift[2] = ['0', 'BEAM_LOOSE_SHIFT']; -$pack_shift[3] = ['0', 'BEAM_TIGHT_SHIFT', '(2*BEAM_TIGHT_SHIFT)']; -$pack_shift[4] = ['0', 'BEAM_LOOSE_SHIFT', # Only for 64 bit wordsize - '(2*BEAM_LOOSE_SHIFT)', - '(3*BEAM_LOOSE_SHIFT)']; - -$pack_mask[2] = ['BEAM_LOOSE_MASK', $WHOLE_WORD]; -$pack_mask[3] = ['BEAM_TIGHT_MASK', 'BEAM_TIGHT_MASK', 'BEAM_TIGHT_MASK']; -$pack_mask[4] = ['BEAM_LOOSE_MASK', # Only for 64 bit wordsize - 'BEAM_LOOSE_MASK', - 'BEAM_LOOSE_MASK', - $WHOLE_WORD]; + +my @basic_pack_options = (0); +my @extended_pack_options = @basic_pack_options; # There are two types of instructions: generic and specific. # The generic instructions are those generated by the Beam compiler. @@ -250,6 +245,7 @@ while (@ARGV && $ARGV[0] =~ /^-(.*)/) { ($target = \&compiler_output), next if /^compiler/; ($outdir = shift), next if /^outdir/; ($wordsize = shift), next if /^wordsize/; + ($code_model = shift), next if /^code-model/; ($verbose = 1), next if /^v/; ($defs{$1} = $2), next if /^D(\w+)=(\w+)/; die "$0: Bad option: -$_\n"; @@ -261,14 +257,21 @@ if ($wordsize == 32) { } elsif ($wordsize == 64) { $defs{'ARCH_32'} = 0; $defs{'ARCH_64'} = 1; + $code_pointers_are_short = $code_model eq 'small'; } # -# Initialize number of arguments per packed word. +# Initialize pack options. # if ($wordsize == 64) { - $pack_mask[3] = ['BEAM_TIGHT_MASK', 'BEAM_TIGHT_MASK', $WHOLE_WORD]; + @basic_pack_options = (0,PACK_JUMP); + @extended_pack_options = @basic_pack_options; + if ($code_pointers_are_short) { + foreach (@basic_pack_options) { + push @extended_pack_options, $_ | PACK_IN_INSTR_WORD; + } + } } # @@ -732,12 +735,19 @@ sub emulator_output { print "#if !defined(ARCH_64)\n"; print qq[ #error "64-bit architecture assumed, but ARCH_64 not defined"\n]; print "#endif\n"; + if ($code_pointers_are_short) { + print "#if !defined(CODE_MODEL_SMALL)\n"; + print qq[ #error "small code model assumed, but CODE_MODEL_SMALL not defined"\n]; + print "#endif\n"; + } print "#define BEAM_WIDE_MASK 0xFFFFFFFFull\n"; print "#define BEAM_LOOSE_MASK 0xFFFFull\n"; print "#define BEAM_TIGHT_MASK 0xFFFFull\n"; + print "#define BEAM_TIGHTEST_MASK 0x3FFull\n"; print "#define BEAM_WIDE_SHIFT 32\n"; print "#define BEAM_LOOSE_SHIFT 16\n"; print "#define BEAM_TIGHT_SHIFT 16\n"; + print "#define BEAM_TIGHTEST_SHIFT 10\n"; } print "\n"; @@ -1138,7 +1148,7 @@ sub combine_instruction_group { foreach (0..$#c_args) { push @first, shift @rest; } - my $size = cg_combined_size($s, 1, @first); + my $size = cg_combined_size($s, @first); $offsets{$s} = $offset unless defined $offsets{$s} and $offsets{$s} < $offset; $offset += $size - 1; @@ -1229,7 +1239,7 @@ sub combine_instruction_group { } my($gen_code,$down,$up) = - cg_combined_code($s, 1, $flags, $offset, + cg_combined_code($s, $flags, $offset, $group_size-$offset, $inc, @first); my $spec_label = "$opcase$label"; $down{$spec_label} = $down; @@ -1280,7 +1290,7 @@ sub micro_label { sub cg_basic { my($name,@args) = @_; - my($size,$code,$pack_spec) = code_gen($name, 1, '', 0, undef, undef, @args); + my($size,$code,$pack_spec) = code_gen($name, \@extended_pack_options, '', 0, undef, undef, @args); $pack_spec = build_pack_spec($pack_spec); ($size,$code,$pack_spec); } @@ -1290,8 +1300,8 @@ sub cg_basic { # sub cg_combined_size { - my($name,$pack,@args) = @_; - my($size) = code_gen($name, $pack, '', 0, undef, undef, @args); + my($name,@args) = @_; + my($size) = code_gen($name, \@basic_pack_options, '', 0, undef, undef, @args); $size; } @@ -1300,8 +1310,9 @@ sub cg_combined_size { # sub cg_combined_code { - my($name,$pack,$extra_comments,$offset,$comp_size,$inc,@args) = @_; - my($size,$code,$pack_spec) = code_gen(@_); + my($name,$extra,$offset,$comp_size,$inc,@args) = @_; + my($size,$code,$pack_spec) = + code_gen($name, \@basic_pack_options, $extra, $offset, $comp_size, $inc, @args); if ($pack_spec eq '') { ($code,'',''); } else { @@ -1311,7 +1322,7 @@ sub cg_combined_code { } sub code_gen { - my($name,$pack,$extra_comments,$offset,$comp_size,$inc,@args) = @_; + my($name,$pack_options,$extra_comments,$offset,$comp_size,$inc,@args) = @_; my $group_size = defined $comp_size ? $comp_size + $inc : undef; my $size = 0; my $flags = ''; @@ -1326,8 +1337,8 @@ sub code_gen { # my $c_code_ref = $c_code{$name}; - if ($pack and defined $c_code_ref and $name ne 'catch') { - ($var_decls, $pack_spec, @args) = do_pack($offset, @args); + if (defined $c_code_ref and $name ne 'catch') { + ($var_decls, $pack_spec, @args) = do_pack($offset, $pack_options, @args); } # @@ -1603,9 +1614,25 @@ sub needs_do_wrapper { } sub do_pack { - my($offset,@args) = @_; + my($offset,$pack_options,@args) = @_; + my $ret = ['', ':', @args]; + my $score = 0; + + foreach my $options (@$pack_options) { + my($this_score,$this_result) = do_pack_one($options, $offset, @args); + if ($this_score > $score) { + $ret = $this_result; + $score = $this_score; + } + } + return @$ret; +} + +sub do_pack_one { + my($options,$offset,@args) = @_; my($packable_args) = 0; my @bits_needed; # Bits needed for each argument. + my $pack_in_iw = $options & PACK_IN_INSTR_WORD; # # Define the minimum number of bits needed for the packable argument types. @@ -1619,6 +1646,10 @@ sub do_pack { 't' => 16); if ($wordsize == 64) { $bits_needed{'I'} = 32; + if ($options & PACK_JUMP) { + $bits_needed{'f'} = 32; + $bits_needed{'j'} = 32; + } } # @@ -1631,51 +1662,46 @@ sub do_pack { } else { push @bits_needed, 0; } - } - - # - # Try to pack 'f' and 'j', but not at expense at worse packing - # for other operands. For example, given the arguments "f x x", we - # want the 'x' operands to be packed, not 'f' and 'x' packed and - # the final 'x' not packed. - # - - if ($wordsize == 64 and $packable_args == 1) { - for (my $i = 0; $i < @args; $i++) { - if ($args[$i] =~ /^[fj]$/) { - $bits_needed[$i] = 32; - $packable_args++; - last; - } + if ($arg =~ /^[fj]$/) { + # Only pack the first occurrence of 'f' or 'j'. + delete $bits_needed{'f'}; + delete $bits_needed{'j'}; } } # - # Nothing to pack unless there are at least 2 packable arguments. + # Return if there is nothing to pack. # - return ('', ':', @args) if $packable_args < 2; + if ($packable_args == 0) { + return (-1); + } elsif ($packable_args == 1 and !$pack_in_iw) { + return (-1); + } # # Determine how many arguments we should pack into each word. # my @args_per_word; my @need_wide_mask; - my $bits = 0; - my $word = 0; - $args_per_word[0] = 0; - $need_wide_mask[0] = 0; + my $bits; + my $this_wordsize; + my $word = -1; + + my $next_word = sub { + $word++; + $args_per_word[$word] = 0; + $need_wide_mask[$word] = 0; + $bits = 0; + $this_wordsize = $wordsize; + }; + + $next_word->(); + $this_wordsize = 32 if $pack_in_iw; for (my $i = 0; $i < @args; $i++) { - if ($bits_needed[$i]) { my $needed = $bits_needed[$i]; + next unless $needed; - my $next_word = sub { - $word++; - $args_per_word[$word] = 0; - $need_wide_mask[$word] = 0; - $bits = 0; - }; - - if ($bits+$needed > $wordsize) { # Does not fit. + if ($bits+$needed > $this_wordsize) { # Does not fit. $next_word->(); } if ($args_per_word[$word] == 4) { # Can't handle more than 4 args. @@ -1695,15 +1721,16 @@ sub do_pack { # Can only pack two things in a word where one # item is 32 bits. Force the next item into # the next word. - $bits = $wordsize; + $bits = $this_wordsize; } - } } # # Try to balance packing between words. # - if ($args_per_word[$#args_per_word] == 1) { + if (@args_per_word == 1 and $args_per_word[0] == 1 and $pack_in_iw) { + # Don't rebalance. + } elsif ($args_per_word[$#args_per_word] == 1) { if ($args_per_word[$#args_per_word-1] < 3) { pop @args_per_word; } else { @@ -1753,43 +1780,51 @@ sub do_pack { # the packing engine works from right-to-left, but we must generate # the instructions from left-to-right because we must calculate # instruction sizes from left-to-right. - my $arg_num = 0; for (my $word = 0; $word < @args_per_word; $word++) { my $ap = 0; # Argument number within word. my $packed_var = "tmp_packed" . ($word+1); my $args_per_word = $args_per_word[$word]; - my @shift; - my @mask; - my @instr; - - if ($need_wide_mask[$word]) { - @shift = ('0', 'BEAM_WIDE_SHIFT'); - @mask = ('BEAM_WIDE_MASK', $WHOLE_WORD); - @instr = ('w', 'w'); - } else { - @shift = @{$pack_shift[$args_per_word]}; - @mask = @{$pack_mask[$args_per_word]}; - @instr = @{$pack_instr[$args_per_word]}; - } + my $pack_word_size = ($pack_in_iw && $word == 0) ? 32 : $wordsize; + + my($shref,$mref,$iref,$unpack_suffix) = + get_pack_parameters($args_per_word, $pack_word_size, + $need_wide_mask[$word]); + my @shift = @$shref; + my @mask = @$mref; + my @instr = @$iref; while ($ap < $args_per_word) { my $reg = $args[$arg_num]; my $this_size = $arg_size{$reg}; + if ($bits_needed[$arg_num]) { $this_size = 0; if ($ap == 0) { - $pack_prefix .= "Eterm $packed_var = " . - arg_offset($size+$offset) . ";\n"; - $up .= "p"; - $down = "P$down"; - $this_size = 1; + my $packed_data; + if ($pack_in_iw and $word == 0) { + $packed_data = "BeamExtraData(I[0])"; + if ($args_per_word == 1) { + $packed_var = $packed_data; + } else { + $pack_prefix .= "Eterm $packed_var = $packed_data;\n"; + } + my $pack = chr(ord('#') + $size); + $down = "$pack$down"; + } else { + $packed_data = arg_offset($size + $offset); + $pack_prefix .= "Eterm $packed_var = $packed_data;\n"; + $down = "P$down"; + $up .= "p"; + $this_size = 1; + } } $down = "$instr[$ap]$down"; my $unpack = make_unpack($packed_var, $shift[$ap], $mask[$ap]); - $args[$arg_num] = "packed:$reg:$this_size:$reg" . "b($unpack)"; + my $macro = "$reg$unpack_suffix"; + $args[$arg_num] = "packed:$reg:$this_size:$macro($unpack)"; $ap++; } else { @@ -1809,7 +1844,98 @@ sub do_pack { } my $pack_spec = "$down:$up"; - return ($pack_prefix, $pack_spec, @args); + my $score = pack_score($options, @args); + + return ($score, [$pack_prefix,$pack_spec,@args]); +} + +sub get_pack_parameters { + my($args_per_word,$pack_word_size,$wide_mask) = @_; + my(@shift,@mask,@instr); + my $unpack_suffix = 'b'; + + if ($wide_mask and $args_per_word > 1) { + @shift = ('0', 'BEAM_WIDE_SHIFT'); + @mask = ('BEAM_WIDE_MASK', $WHOLE_WORD); + @instr = (PACK_CMD_WIDE) x 2; + } elsif ($args_per_word == 1) { + @shift = ('0'); + @mask = ($WHOLE_WORD); + @instr = (PACK_CMD_WIDE); + } elsif ($args_per_word == 2) { + if ($pack_word_size != $wordsize) { + # 64-bit word size, pack 32 bits into instruction word. + @shift = ('0', 'BEAM_TIGHT_SHIFT'); + @mask = ('BEAM_TIGHT_MASK', $WHOLE_WORD); + @instr = (PACK_CMD_TIGHT) x 2; + } else { + # 32/64 bit word size + @shift = ('0', 'BEAM_LOOSE_SHIFT'); + @mask = ('BEAM_LOOSE_MASK', $WHOLE_WORD); + @instr = (PACK_CMD_LOOSE) x 2; + } + } elsif ($args_per_word == 3) { + if ($pack_word_size != $wordsize) { + # 64-bit word size, pack 3 register numbers into instruction word. + @shift = ('0', 'BEAM_TIGHTEST_SHIFT', '(2*BEAM_TIGHTEST_SHIFT)'); + @mask = ('BEAM_TIGHTEST_MASK', 'BEAM_TIGHTEST_MASK', $WHOLE_WORD); + @instr = (PACK_CMD_TIGHTEST) x 3; + $unpack_suffix = ''; + } else { + # 32/64 bit word size. + @shift = ('0', 'BEAM_TIGHT_SHIFT', '(2*BEAM_TIGHT_SHIFT)'); + if ($wordsize == 32) { + @mask = ('BEAM_TIGHT_MASK') x 3; + } elsif ($wordsize == 64) { + @mask = ('BEAM_TIGHT_MASK', 'BEAM_TIGHT_MASK', $WHOLE_WORD); + } + @instr = (PACK_CMD_TIGHT) x 3; + } + } elsif ($args_per_word == 4) { + # 64 bit word size only. + @shift = ('0', + 'BEAM_LOOSE_SHIFT', + '(2*BEAM_LOOSE_SHIFT)', + '(3*BEAM_LOOSE_SHIFT)'); + @mask = ('BEAM_LOOSE_MASK', 'BEAM_LOOSE_MASK', + 'BEAM_LOOSE_MASK', $WHOLE_WORD); + @instr = (PACK_CMD_LOOSE) x 4; + } + + unless (@shift) { + error("internal error: args_per_word=$args_per_word, " . + "pack_word_size=$pack_word_size"); + } + + (\@shift,\@mask,\@instr,$unpack_suffix); +} + +sub pack_score { + my($options,@args) = @_; + my $size = 0; + + # Calculate the number of words. + foreach (@args) { + if (/^packed:[^:]*:(\d+)/) { + $size += $1; + } else { + $size += $arg_size{$_} + } + } + + # Less numbers of words give a higher score; for the same number of + # words, using PACK_JUMP or PACK_IN_INSTR_WORD gives a lower score. + my $score = 1 + $max_spec_operands*($max_spec_operands - $size); + if ($options == PACK_IN_INSTR_WORD) { + $score += 0; + } elsif ($options == PACK_JUMP) { + $score += 1; + } elsif ($options == (PACK_JUMP|PACK_IN_INSTR_WORD)) { + $score += 2; + } elsif ($options == 0) { + $score += 3; + } + $score; } sub make_unpack { -- cgit v1.2.3 From 985524704ddd62cf85385a323861377608d66c9c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Fri, 15 Sep 2017 12:29:58 +0200 Subject: Optimize instruction prefetch --- erts/emulator/beam/beam_emu.c | 2 ++ erts/emulator/utils/beam_makeops | 4 ++-- 2 files changed, 4 insertions(+), 2 deletions(-) (limited to 'erts') diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 73c4e3532b..aa94fbf536 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -52,11 +52,13 @@ # define CountCase(OpCode) case op_count_##OpCode # define IsOpCode(InstrWord, OpCode) (BeamCodeAddr(InstrWord) == (BeamInstr)op_##OpCode) # define Goto(Rel) {Go = BeamCodeAddr(Rel); goto emulator_loop;} +# define GotoPF(Rel) Goto(Rel) #else # define OpCase(OpCode) lb_##OpCode # define CountCase(OpCode) lb_count_##OpCode # define IsOpCode(InstrWord, OpCode) (BeamCodeAddr(InstrWord) == (BeamInstr)&&lb_##OpCode) # define Goto(Rel) goto *((void *)BeamCodeAddr(Rel)) +# define GotoPF(Rel) goto *((void *)Rel) # define LabelAddr(Label) &&Label #endif diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops index 388e3d164d..322d60b00e 100755 --- a/erts/emulator/utils/beam_makeops +++ b/erts/emulator/utils/beam_makeops @@ -1452,10 +1452,10 @@ sub code_gen { "ASSERT(VALID_INSTR(*I));\n" . "Goto(*I);"; } else { - $var_decls .= "BeamInstr next_pf = I[$instr_offset];\n"; + $var_decls .= "BeamInstr next_pf = BeamCodeAddr(I[$instr_offset]);\n"; $dispatch_next = "\nI += $instr_offset;\n" . "ASSERT(VALID_INSTR(next_pf));\n" . - "Goto(next_pf);"; + "GotoPF(next_pf);"; } # -- cgit v1.2.3 From f2288e390ab660eca5af747e017894ecd8e5ba58 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 26 Sep 2017 07:33:18 +0200 Subject: beam_makeops: Refactor parsing of specific instructions --- erts/emulator/utils/beam_makeops | 55 +++++++++++++++++++++------------------- 1 file changed, 29 insertions(+), 26 deletions(-) (limited to 'erts') diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops index 322d60b00e..c8550df1e2 100755 --- a/erts/emulator/utils/beam_makeops +++ b/erts/emulator/utils/beam_makeops @@ -453,15 +453,7 @@ while (<>) { # Parse specific instructions (only present in emulator/loader): # Name Arg1 Arg2... # - my($name, @args) = split; - error("too many operands") - if @args > $max_spec_operands; - syntax_check($name, @args); - my $arity = @args; - if (defined $gen_opnum{$name,$arity} and $obsolete[$gen_opnum{$name,$arity}]) { - error("specific instructions may not be specified for obsolete instructions"); - } - save_specific_ops($name, $arity, $hotness, @args); + my($name,$arity) = parse_specific_op($_); if (defined $op_num) { error("specific instructions must not be numbered"); } elsif (!defined($gen_arity{$name}) && !defined($unnumbered{$name,$arity})) { @@ -981,40 +973,51 @@ sub compiler_output { } # -# Check an operation for validity. +# Parse and store a specific operation. # -sub syntax_check { - my($name, @args) = @_; - my($i); +sub parse_specific_op { + my($name, @args) = split " ", shift; + my $arity = @args; + # Check for various errors. error("Bad opcode name '$name'") unless $name =~ /^[a-z][\w\d_]*$/; - for ($i = 0; $i < @args; $i++) { + error("too many operands") + if @args > $max_spec_operands; + for (my $i = 0; $i < $arity; $i++) { foreach my $type (split(//, $args[$i])) { error("Argument " . ($i+1) . ": invalid type '$type'") unless defined $arg_size{$type}; } } -} - -sub save_specific_ops { - my($name,$arity,$hot,@args) = @_; - my(@res) = (""); + if (defined $gen_opnum{$name,$arity} and $obsolete[$gen_opnum{$name,$arity}]) { + error("specific instructions may not be specified for obsolete instructions"); + } + # Expand operands with multiple types to multiple instructions. + # (For example, "get_list xy xy xy" will be expanded to six instructions.) + my @res = ([]); foreach my $arg (@args) { - my @new_res = (); + my @old_res = @res; + @res = (); foreach my $type (split(//, $arg)) { - foreach my $args (@res) { - push @new_res, "$args$type"; + foreach my $args_ref (@old_res) { + my @args = @$args_ref; + push @args, $type; + push @res, \@args; } } - @res = @new_res; } + + # Store each specific instruction. my $key = "$name/$arity"; - foreach my $args (@res) { - @args = split //, $args; - push @{$specific_op{$key}}, [$name,$hot,@args]; + foreach my $args_ref (@res) { + @args = @$args_ref; + push @{$specific_op{$key}}, [$name,$hotness,@args]; } + + # Done. + ($name,$arity); } sub parse_c_args { -- cgit v1.2.3 From e86262c45eb3ccbd055034239ddcd19472e56b2f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 26 Sep 2017 08:15:02 +0200 Subject: Introduce a syntax for marking operands as "optional use" Introduce a syntax to mark an operand that is not always used when an instrution is executed. Example of such operands are the fail label for is_nil or the number of live registers for an allocate instruction. Use a question mark to annotate optional use: is_nil f? xy allocate t t? --- erts/emulator/beam/ops.tab | 262 +++++++++++++++++++-------------------- erts/emulator/utils/beam_makeops | 13 +- 2 files changed, 141 insertions(+), 134 deletions(-) (limited to 'erts') diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab index b7ef1f0599..4a915c7762 100644 --- a/erts/emulator/beam/ops.tab +++ b/erts/emulator/beam/ops.tab @@ -99,21 +99,21 @@ line Loc | func_info M F A => func_info M F A | line Loc line I -allocate t t -allocate_heap t I t +allocate t t? +allocate_heap t I t? %cold deallocate Q %hot init y -allocate_zero t t -allocate_heap_zero t I t +allocate_zero t t? +allocate_heap_zero t I t? trim N Remaining => i_trim N i_trim t -test_heap I t +test_heap I t? allocate_heap S u==0 R => allocate S R allocate_heap_zero S u==0 R => allocate_zero S R @@ -158,19 +158,19 @@ is_tuple Fail=f S | select_tuple_arity S=d Fail=f Size=u Rest=* => \ select_tuple_arity S=d Fail=f Size=u Rest=* => \ gen_select_tuple_arity(S, Fail, Size, Rest) -i_select_val_bins xy f I +i_select_val_bins xy f? I -i_select_val_lins xy f I +i_select_val_lins xy f? I -i_select_val2 xy f c c +i_select_val2 xy f? c c -i_select_tuple_arity xy f I +i_select_tuple_arity xy f? I -i_select_tuple_arity2 xy f A A +i_select_tuple_arity2 xy f? A A -i_jump_on_val_zero xy f I +i_jump_on_val_zero xy f? I -i_jump_on_val xy f I W +i_jump_on_val xy f? I W get_list xy xy xy @@ -213,9 +213,9 @@ i_get_tuple_element2y x P y y i_get_tuple_element3 x P x %cold -is_number f x -is_number f y +is_number f? xy %hot + is_number Fail=f i => is_number Fail=f na => jump Fail is_number Fail Literal=q => move Literal x | is_number Fail x @@ -446,37 +446,37 @@ is_ne_exact Lbl C=c R=xy => is_ne_exact Lbl R C is_ne_exact Lbl R=xy C=ian => i_is_ne_exact_immed Lbl R C is_ne_exact Lbl R=xy C=q => i_is_ne_exact_literal Lbl R C -i_is_eq_exact_immed f rxy c +i_is_eq_exact_immed f? rxy c -i_is_eq_exact_literal f xy c +i_is_eq_exact_literal f? xy c -i_is_ne_exact_immed f xy c +i_is_ne_exact_immed f? xy c -i_is_ne_exact_literal f xy c +i_is_ne_exact_literal f? xy c is_eq_exact Lbl Y=y X=x => is_eq_exact Lbl X Y -is_eq_exact f x xy -is_eq_exact f y y +is_eq_exact f? x xy +is_eq_exact f? y y -is_ne_exact f S S +is_ne_exact f? S S -is_lt f x x -is_lt f x c -is_lt f c x +is_lt f? x x +is_lt f? x c +is_lt f? c x %cold -is_lt f s s +is_lt f? s s %hot -is_ge f x x -is_ge f x c -is_ge f c x +is_ge f? x x +is_ge f? x c +is_ge f? c x %cold -is_ge f s s +is_ge f? s s %hot -is_eq f s s +is_eq f? s s -is_ne f s s +is_ne f? s s # # Putting things. @@ -583,7 +583,7 @@ is_tagged_tuple Fail Literal=q Arity Atom => \ move Literal x | is_tagged_tuple Fail x Arity Atom is_tagged_tuple Fail=f c Arity Atom => jump Fail -is_tagged_tuple f rxy A a +is_tagged_tuple f? rxy A a # Test tuple & arity (head) @@ -591,14 +591,14 @@ is_tuple Fail Literal=q => move Literal x | is_tuple Fail x is_tuple Fail=f c => jump Fail is_tuple Fail=f S=xy | test_arity Fail=f S=xy Arity => is_tuple_of_arity Fail S Arity -is_tuple_of_arity f rxy A +is_tuple_of_arity f? rxy A -is_tuple f rxy +is_tuple f? rxy test_arity Fail Literal=q Arity => move Literal x | test_arity Fail x Arity test_arity Fail=f c Arity => jump Fail -test_arity f xy A +test_arity f? xy A get_tuple_element Reg=x P1 D1=x | get_tuple_element Reg=x P2 D2=x | \ get_tuple_element Reg=x P3 D3=x | \ @@ -619,16 +619,16 @@ is_integer Fail Literal=q => move Literal x | is_integer Fail x is_integer Fail=f S=x | allocate Need Regs => is_integer_allocate Fail S Need Regs -is_integer_allocate f x t t +is_integer_allocate f? x t t -is_integer f xy +is_integer f? xy is_list Fail=f n => is_list Fail Literal=q => move Literal x | is_list Fail x is_list Fail=f c => jump Fail -is_list f x +is_list f? x %cold -is_list f y +is_list f? y %hot is_nonempty_list Fail=f S=x | allocate Need Rs => is_nonempty_list_allocate Fail S Need Rs @@ -638,21 +638,21 @@ is_nonempty_list F=f x==0 | test_heap I1 I2 => is_nonempty_list_test_heap F I1 I is_nonempty_list Fail=f S=x | get_list S D1=x D2=x => \ is_nonempty_list_get_list Fail S D1 D2 -is_nonempty_list_allocate f rx t t -is_nonempty_list_test_heap f I t -is_nonempty_list_get_list f rx x x -is_nonempty_list f xy +is_nonempty_list_allocate f? rx t t +is_nonempty_list_test_heap f? I t +is_nonempty_list_get_list f? rx x x +is_nonempty_list f? xy -is_atom f x +is_atom f? x %cold -is_atom f y +is_atom f? y %hot is_atom Fail=f a => is_atom Fail=f niq => jump Fail -is_float f x +is_float f? x %cold -is_float f y +is_float f? y %hot is_float Fail=f nai => jump Fail is_float Fail Literal=q => move Literal x | is_float Fail x @@ -660,13 +660,13 @@ is_float Fail Literal=q => move Literal x | is_float Fail x is_nil Fail=f n => is_nil Fail=f qia => jump Fail -is_nil f xy +is_nil f? xy is_binary Fail Literal=q => move Literal x | is_binary Fail x is_binary Fail=f c => jump Fail -is_binary f x +is_binary f? x %cold -is_binary f y +is_binary f? y %hot # XXX Deprecated. @@ -674,27 +674,27 @@ is_bitstr Fail Term => is_bitstring Fail Term is_bitstring Fail Literal=q => move Literal x | is_bitstring Fail x is_bitstring Fail=f c => jump Fail -is_bitstring f x +is_bitstring f? x %cold -is_bitstring f y +is_bitstring f? y %hot is_reference Fail=f cq => jump Fail -is_reference f x +is_reference f? x %cold -is_reference f y +is_reference f? y %hot is_pid Fail=f cq => jump Fail -is_pid f x +is_pid f? x %cold -is_pid f y +is_pid f? y %hot is_port Fail=f cq => jump Fail -is_port f x +is_port f? x %cold -is_port f y +is_port f? y %hot is_boolean Fail=f a==am_true => @@ -702,19 +702,19 @@ is_boolean Fail=f a==am_false => is_boolean Fail=f ac => jump Fail %cold -is_boolean f xy +is_boolean f? xy %hot is_function2 Fail=f acq Arity => jump Fail is_function2 Fail=f Fun a => jump Fail -is_function2 f S s +is_function2 f? S s # Allocating & initializing. allocate Need Regs | init Y => allocate_init Need Regs Y init Y1 | init Y2 => init2 Y1 Y2 -allocate_init t t y +allocate_init t t? y ################################################################# # External function and bif calls. @@ -1004,13 +1004,13 @@ node y # Note: 'I' is sufficient because this instruction will only be used # if the arity fits in 24 bits. -i_fast_element xy j I d +i_fast_element xy j? I d -i_element xy j s d +i_element xy j? s d -bif1 f b s d +bif1 f? b s d bif1_body b s d -i_bif2 f b s s d +i_bif2 f? b s s d i_bif2_body b s s d # @@ -1062,7 +1062,7 @@ make_fun2 OldIndex=u => gen_make_fun2(OldIndex) i_make_fun W t %hot -is_function f xy +is_function f? xy is_function Fail=f c => jump Fail func_info M F A => i_func_info u M F A @@ -1091,24 +1091,24 @@ i_bs_match_string x f W W bs_get_integer2 Fail=f Ms=x Live=u Sz=sq Unit=u Flags=u Dst=d => \ gen_get_integer2(Fail, Ms, Live, Sz, Unit, Flags, Dst) -i_bs_get_integer_small_imm x W f t x -i_bs_get_integer_imm x W t f t x -i_bs_get_integer f t t x s x -i_bs_get_integer_8 x f x -i_bs_get_integer_16 x f x +i_bs_get_integer_small_imm x W f? t x +i_bs_get_integer_imm x W t f? t x +i_bs_get_integer f? t t x s x +i_bs_get_integer_8 x f? x +i_bs_get_integer_16 x f? x %if ARCH_64 -i_bs_get_integer_32 x f x +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 => \ gen_get_binary2(Fail, Ms, Live, Sz, Unit, Flags, Dst) -i_bs_get_binary_imm2 f x t W t x -i_bs_get_binary2 f x t s t x -i_bs_get_binary_all2 f x t t x -i_bs_get_binary_all_reuse x f t +i_bs_get_binary_imm2 f? x t W t x +i_bs_get_binary2 f x t? s t x +i_bs_get_binary_all2 f? x t t x +i_bs_get_binary_all_reuse x f? t # Fetching float from binaries. bs_get_float2 Fail=f Ms=x Live=u Sz=s Unit=u Flags=u Dst=d => \ @@ -1116,25 +1116,25 @@ bs_get_float2 Fail=f Ms=x Live=u Sz=s Unit=u Flags=u Dst=d => \ bs_get_float2 Fail=f Ms=x Live=u Sz=q Unit=u Flags=u Dst=d => jump Fail -i_bs_get_float2 f x t s t x +i_bs_get_float2 f? x t s t x # Miscellanous bs_skip_bits2 Fail=f Ms=x Sz=sq Unit=u Flags=u => \ gen_skip_bits2(Fail, Ms, Sz, Unit, Flags) -i_bs_skip_bits_imm2 f x W -i_bs_skip_bits2 f x xy t -i_bs_skip_bits_all2 f x t +i_bs_skip_bits_imm2 f? x W +i_bs_skip_bits2 f? x xy t +i_bs_skip_bits_all2 f? x t bs_test_tail2 Fail=f Ms=x Bits=u==0 => bs_test_zero_tail2 Fail Ms bs_test_tail2 Fail=f Ms=x Bits=u => bs_test_tail_imm2 Fail Ms Bits -bs_test_zero_tail2 f x -bs_test_tail_imm2 f x W +bs_test_zero_tail2 f? x +bs_test_tail_imm2 f? x W bs_test_unit F Ms Unit=u==8 => bs_test_unit8 F Ms -bs_test_unit f x t -bs_test_unit8 f x +bs_test_unit f? x t +bs_test_unit8 f? x # An y register operand for bs_context_to_binary is rare, # but can happen because of inlining. @@ -1150,14 +1150,14 @@ bs_context_to_binary x # Utf8/utf16/utf32 support. (R12B-5) # bs_get_utf8 Fail=f Ms=x u u Dst=d => i_bs_get_utf8 Ms Fail Dst -i_bs_get_utf8 x f x +i_bs_get_utf8 x f? x bs_skip_utf8 Fail=f Ms=x u u => i_bs_get_utf8 Ms Fail x bs_get_utf16 Fail=f Ms=x u Flags=u Dst=d => i_bs_get_utf16 Ms Fail Flags Dst bs_skip_utf16 Fail=f Ms=x u Flags=u => i_bs_get_utf16 Ms Fail Flags x -i_bs_get_utf16 x f t x +i_bs_get_utf16 x f? t x bs_get_utf32 Fail=f Ms=x Live=u Flags=u Dst=d => \ bs_get_integer2 Fail Ms Live i=32 u=1 Flags Dst | \ @@ -1186,13 +1186,13 @@ bs_init2 Fail Sz Words=u==0 Regs Flags Dst => \ bs_init2 Fail Sz Words Regs Flags Dst => \ i_bs_init_fail_heap Sz Words Fail Regs Dst -i_bs_init_fail xy j t x +i_bs_init_fail xy j? t? x -i_bs_init_fail_heap s I j t x +i_bs_init_fail_heap s I j? t? x -i_bs_init W t x +i_bs_init W t? x -i_bs_init_heap W I t x +i_bs_init_heap W I t? x bs_init_bits Fail Sz=o Words Regs Flags Dst => system_limit Fail @@ -1205,16 +1205,16 @@ bs_init_bits Fail Sz Words=u==0 Regs Flags Dst => \ bs_init_bits Fail Sz Words Regs Flags Dst => \ i_bs_init_bits_fail_heap Sz Words Fail Regs Dst -i_bs_init_bits_fail xy j t x +i_bs_init_bits_fail xy j? t? x -i_bs_init_bits_fail_heap s I j t x +i_bs_init_bits_fail_heap s I j? t? x -i_bs_init_bits W t x -i_bs_init_bits_heap W I t x +i_bs_init_bits W t? x +i_bs_init_bits_heap W I t? x bs_add Fail S1=i==0 S2 Unit=u==1 D => move S2 D -bs_add j s s t x +bs_add j? s s t? x bs_append Fail Size Extra Live Unit Bin Flags Dst => \ move Bin x | i_bs_append Fail Extra Live Unit Size Dst @@ -1224,8 +1224,8 @@ bs_private_append Fail Size Unit Bin Flags Dst => \ bs_init_writable -i_bs_append j I t t s x -i_bs_private_append j t s S x +i_bs_append j? I t? t s x +i_bs_private_append j? t s S x # # Storing integers into binaries. @@ -1234,8 +1234,8 @@ i_bs_private_append j t s S x bs_put_integer Fail=j Sz=sq Unit=u Flags=u Src=s => \ gen_put_integer(Fail, Sz, Unit, Flags, Src) -i_new_bs_put_integer j s t s -i_new_bs_put_integer_imm j W t s +i_new_bs_put_integer j? s t s +i_new_bs_put_integer_imm j? W t s # # Utf8/utf16/utf32 support. (R12B-5) @@ -1251,14 +1251,14 @@ i_bs_utf16_size s x bs_put_utf8 Fail u Src=s => i_bs_put_utf8 Fail Src -i_bs_put_utf8 j s +i_bs_put_utf8 j? s -bs_put_utf16 j t s +bs_put_utf16 j? t s bs_put_utf32 Fail=j Flags=u Src=s => \ i_bs_validate_unicode Fail Src | bs_put_integer Fail i=32 u=1 Flags Src -i_bs_validate_unicode j s +i_bs_validate_unicode j? s # # Storing floats into binaries. @@ -1268,8 +1268,8 @@ bs_put_float Fail Sz=q Unit Flags Val => badarg Fail bs_put_float Fail=j Sz=s Unit=u Flags=u Src=s => \ gen_put_float(Fail, Sz, Unit, Flags, Src) -i_new_bs_put_float j s t s -i_new_bs_put_float_imm j W t s +i_new_bs_put_float j? s t s +i_new_bs_put_float_imm j? W t s # # Storing binaries into binaries. @@ -1278,9 +1278,9 @@ i_new_bs_put_float_imm j W t s bs_put_binary Fail=j Sz=s Unit=u Flags=u Src=s => \ gen_put_binary(Fail, Sz, Unit, Flags, Src) -i_new_bs_put_binary j s t s -i_new_bs_put_binary_imm j W s -i_new_bs_put_binary_all j s t +i_new_bs_put_binary j? s t s +i_new_bs_put_binary_imm j? W s +i_new_bs_put_binary_all j? s t # # Warning: The i_bs_put_string and i_new_bs_put_string instructions @@ -1394,12 +1394,12 @@ new_map Dst Live Size Rest=* | is_small_map_literal_keys(Size, Rest) => \ new_map d t I i_new_small_map_lit d t q update_map_assoc s d t I -update_map_exact j s d t I +update_map_exact j? s d t I is_map Fail Lit=q | literal_is_map(Lit) => is_map Fail cq => jump Fail -is_map f xy +is_map f? xy ## Transform has_map_fields #{ K1 := _, K2 := _ } to has_map_elements @@ -1413,14 +1413,14 @@ get_map_elements Fail Src=xy Size=u==2 Rest=* => \ get_map_elements Fail Src Size Rest=* | map_key_sort(Size, Rest) => \ gen_get_map_elements(Fail, Src, Size, Rest) -i_get_map_elements f s I +i_get_map_elements f? s I i_get_map_element Fail Src=xy Key=y Dst => \ move Key x | i_get_map_element Fail Src x Dst -i_get_map_element_hash f xy c I xy +i_get_map_element_hash f? xy c I xy -i_get_map_element f xy x xy +i_get_map_element f? xy x xy # # Convert the plus operations to a generic plus instruction. @@ -1488,32 +1488,32 @@ gc_bif1 Fail I u$bif:erlang:bnot/1 Src Dst=d => i_int_bnot Fail Src I Dst i_increment rxy W t d -i_plus x xy j t d -i_plus s s j t d +i_plus x xy j? t d +i_plus s s j? t d -i_minus x x j t d -i_minus s s j t d +i_minus x x j? t d +i_minus s s j? t d -i_times j t s s d +i_times j? t s s d -i_m_div j t s s d -i_int_div j t s s d +i_m_div j? t s s d +i_int_div j? t s s d -i_rem x x j t d -i_rem s s j t d +i_rem x x j? t d +i_rem s s j? t d -i_bsl s s j t d -i_bsr s s j t d +i_bsl s s j? t d +i_bsr s s j? t d -i_band x c j t d -i_band s s j t d +i_band x c j? t d +i_band s s j? t d -i_bor j I s s d -i_bxor j I s s d +i_bor j? I s s d +i_bxor j? I s s d i_int_bnot Fail Src=c Live Dst => move Src x | i_int_bnot Fail x Live Dst -i_int_bnot j S t d +i_int_bnot j? S t d # # Old guard BIFs that creates heap fragments are no longer allowed. @@ -1537,9 +1537,9 @@ gc_bif2 Fail I Bif S1 S2 Dst => \ gc_bif3 Fail I Bif S1 S2 S3 Dst => \ gen_guard_bif3(Fail, I, Bif, S1, S2, S3, Dst) -i_gc_bif1 j W s t d +i_gc_bif1 j? W s t? d -i_gc_bif2 j W t s s d +i_gc_bif2 j? W t? s s d ii_gc_bif3/7 @@ -1548,7 +1548,7 @@ ii_gc_bif3/7 ii_gc_bif3 Fail Bif Live S1 S2 S3 Dst => \ move S1 x | i_gc_bif3 Fail Bif Live S2 S3 Dst -i_gc_bif3 j W t s s d +i_gc_bif3 j? W t? s s d # # The following instruction is specially handled in beam_load.c diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops index c8550df1e2..d1c51e5dad 100755 --- a/erts/emulator/utils/beam_makeops +++ b/erts/emulator/utils/beam_makeops @@ -526,7 +526,6 @@ sub emulator_output { foreach $key (keys %specific_op) { foreach (@{$specific_op{$key}}) { my($name, $hotness, @args) = @$_; - my $sign = join('', @args); my $print_name = print_name($name, @args); my($size, $code, $pack_spec) = cg_basic($name, @args); @@ -597,6 +596,7 @@ sub emulator_output { foreach (@{$specific_op{$key}}) { my($name, $hot, @args) = @{$_}; my($sign) = join('', @args); + $sign =~ s/[?]//g; # The primitive types should sort before other types. @@ -614,6 +614,7 @@ sub emulator_output { my $print_name = $items{$sort_key}; my $info = $spec_op_info{$print_name}; my(@args) = @{$info->{'args'}}; + @args = map { s/[?]$//; $_ } @args; my $arity = @args; # @@ -854,6 +855,7 @@ sub emulator_output { sub print_name { my($name,@args) = @_; my $sign = join '', @args; + $sign =~ s/[?]//g; $sign ne '' ? "${name}_$sign" : $name; } @@ -985,7 +987,9 @@ sub parse_specific_op { error("too many operands") if @args > $max_spec_operands; for (my $i = 0; $i < $arity; $i++) { - foreach my $type (split(//, $args[$i])) { + my $arg = $args[$i]; + $arg =~ s/[?]$//; + foreach my $type (split(//, $arg)) { error("Argument " . ($i+1) . ": invalid type '$type'") unless defined $arg_size{$type}; } @@ -1000,10 +1004,11 @@ sub parse_specific_op { foreach my $arg (@args) { my @old_res = @res; @res = (); + my $marker = ($arg =~ s/[?]$//) ? '?' : ''; foreach my $type (split(//, $arg)) { foreach my $args_ref (@old_res) { my @args = @$args_ref; - push @args, $type; + push @args, "$type$marker"; push @res, \@args; } } @@ -1351,6 +1356,7 @@ sub code_gen { my $need_block = 0; my $arg_offset = $offset; + @args = map { s/[?]$//g; $_ } @args; foreach (@args) { my($this_size) = $arg_size{$_}; SWITCH: @@ -1618,6 +1624,7 @@ sub needs_do_wrapper { sub do_pack { my($offset,$pack_options,@args) = @_; + @args = map { s/[?]$//; $_ } @args; my $ret = ['', ':', @args]; my $score = 0; -- cgit v1.2.3 From 43f1817f3367bf3aa346c8b3dae10862d3723515 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 27 Sep 2017 15:11:17 +0200 Subject: beam_makeops: Print the instruction name for fatal packing errors Having the instruction name available in the functions that implement packing also simplifies debugging. --- erts/emulator/utils/beam_makeops | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) (limited to 'erts') diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops index d1c51e5dad..a705ba27b7 100755 --- a/erts/emulator/utils/beam_makeops +++ b/erts/emulator/utils/beam_makeops @@ -1346,7 +1346,7 @@ sub code_gen { my $c_code_ref = $c_code{$name}; if (defined $c_code_ref and $name ne 'catch') { - ($var_decls, $pack_spec, @args) = do_pack($offset, $pack_options, @args); + ($var_decls, $pack_spec, @args) = do_pack($name, $offset, $pack_options, @args); } # @@ -1623,13 +1623,13 @@ sub needs_do_wrapper { } sub do_pack { - my($offset,$pack_options,@args) = @_; + my($name,$offset,$pack_options,@args) = @_; @args = map { s/[?]$//; $_ } @args; my $ret = ['', ':', @args]; my $score = 0; foreach my $options (@$pack_options) { - my($this_score,$this_result) = do_pack_one($options, $offset, @args); + my($this_score,$this_result) = do_pack_one($name, $options, $offset, @args); if ($this_score > $score) { $ret = $this_result; $score = $this_score; @@ -1639,7 +1639,7 @@ sub do_pack { } sub do_pack_one { - my($options,$offset,@args) = @_; + my($name,$options,$offset,@args) = @_; my($packable_args) = 0; my @bits_needed; # Bits needed for each argument. my $pack_in_iw = $options & PACK_IN_INSTR_WORD; @@ -1798,7 +1798,7 @@ sub do_pack_one { my $pack_word_size = ($pack_in_iw && $word == 0) ? 32 : $wordsize; my($shref,$mref,$iref,$unpack_suffix) = - get_pack_parameters($args_per_word, $pack_word_size, + get_pack_parameters($name, $args_per_word, $pack_word_size, $need_wide_mask[$word]); my @shift = @$shref; my @mask = @$mref; @@ -1860,7 +1860,7 @@ sub do_pack_one { } sub get_pack_parameters { - my($args_per_word,$pack_word_size,$wide_mask) = @_; + my($name,$args_per_word,$pack_word_size,$wide_mask) = @_; my(@shift,@mask,@instr); my $unpack_suffix = 'b'; @@ -1913,7 +1913,7 @@ sub get_pack_parameters { } unless (@shift) { - error("internal error: args_per_word=$args_per_word, " . + error("$name: internal packing error: args_per_word=$args_per_word, " . "pack_word_size=$pack_word_size"); } -- cgit v1.2.3 From d7588c53399dfa369ae2af6874e69d252d062054 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 27 Sep 2017 17:26:53 +0200 Subject: Optimize packing for "optional use" operands Operands that are marked with a "?" are not always used when an instruction is executed. Enhance the packing algorithm to place optional use operands into the instruction word even they are not the first operand (as long as the total instruction size stays the same). Here are the instructions that will be packed differently because of this change: allocate_heap t I t? allocate_heap_zero t I t? test_heap I t? i_bs_get_integer_8 x f? x i_bs_get_integer_16 x f? x i_bs_get_integer_32 x f? x --- erts/emulator/utils/beam_makeops | 66 +++++++++++++++++++++++++++++++--------- 1 file changed, 52 insertions(+), 14 deletions(-) (limited to 'erts') diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops index a705ba27b7..9da62f18ac 100755 --- a/erts/emulator/utils/beam_makeops +++ b/erts/emulator/utils/beam_makeops @@ -27,6 +27,7 @@ use constant HOT => 2; # Instructions for packing use constant PACK_JUMP => 1; use constant PACK_IN_INSTR_WORD => 2; +use constant PACK_OPT_IN_INSTR_WORD => 4; # Packing commands use constant PACK_CMD_TIGHTEST => '1'; @@ -1623,13 +1624,38 @@ sub needs_do_wrapper { } sub do_pack { - my($name,$offset,$pack_options,@args) = @_; - @args = map { s/[?]$//; $_ } @args; + my($name,$offset,$pack_opts_ref,@args) = @_; + my @pack_opts = @$pack_opts_ref; + my $opt_arg_pos = -1; + + # Look for an optional use operand not as the first argument. + if (@args and $args[0] !~ /[?]$/) { + for (my $pos = 0; $pos < @args; $pos++) { + if ($args[$pos] =~ /[?]$/) { + $opt_arg_pos = $pos; + last; + } + } + } + + @args = map { s/[?]$//; $_ } @args; # Remove any optional use marker. + + # If there is an optional operand, extend the array of pack options. + if ($opt_arg_pos >= 0) { + my @new_pack_opts = grep { $_ & PACK_IN_INSTR_WORD } @pack_opts; + @new_pack_opts = map { + ($_ & ~ PACK_IN_INSTR_WORD) | PACK_OPT_IN_INSTR_WORD; + } @new_pack_opts; + push @pack_opts, @new_pack_opts; + } + my $ret = ['', ':', @args]; my $score = 0; - foreach my $options (@$pack_options) { - my($this_score,$this_result) = do_pack_one($name, $options, $offset, @args); + foreach my $options (@pack_opts) { + my $this_opt_arg_pos = ($options & PACK_OPT_IN_INSTR_WORD) ? $opt_arg_pos : -1; + my($this_score,$this_result) = + do_pack_one($name, $options, $this_opt_arg_pos, $offset, @args); if ($this_score > $score) { $ret = $this_result; $score = $this_score; @@ -1639,7 +1665,7 @@ sub do_pack { } sub do_pack_one { - my($name,$options,$offset,@args) = @_; + my($name,$options,$opt_arg_pos,$offset,@args) = @_; my($packable_args) = 0; my @bits_needed; # Bits needed for each argument. my $pack_in_iw = $options & PACK_IN_INSTR_WORD; @@ -1684,7 +1710,7 @@ sub do_pack_one { # if ($packable_args == 0) { return (-1); - } elsif ($packable_args == 1 and !$pack_in_iw) { + } elsif ($packable_args == 1 and $options == 0) { return (-1); } @@ -1707,9 +1733,11 @@ sub do_pack_one { $next_word->(); $this_wordsize = 32 if $pack_in_iw; - for (my $i = 0; $i < @args; $i++) { - my $needed = $bits_needed[$i]; + for (my $arg_num = 0; $arg_num < @args; $arg_num++) { + my $needed = $bits_needed[$arg_num]; + next unless $needed; + next if $arg_num == $opt_arg_pos; if ($bits+$needed > $this_wordsize) { # Does not fit. $next_word->(); @@ -1765,12 +1793,19 @@ sub do_pack_one { # beginning). my $up = ''; # Pack commands (storing back while # moving forward). + my $arg_num = 0; # Number of argument. - # Skip an unpackable argument. + # Skip an unpackable argument. Also handle packing of + # an single operand into the instruction word. my $skip_unpackable = sub { my($arg) = @_; - if ($arg_size{$arg}) { + if ($arg_num == $opt_arg_pos) { + my $pack = chr(ord('#') + $arg_num); + $down = PACK_CMD_WIDE . "$pack$down"; + my $unpack = "BeamExtraData(I[0])"; + $args[$arg_num] = "packed:$arg:0:${arg}b($unpack)"; + } elsif ($arg_size{$arg}) { # Save the argument on the pack engine's stack. my $push = 'g'; if ($type_bit{$arg} & $type_bit{'q'}) { @@ -1790,7 +1825,6 @@ sub do_pack_one { # the packing engine works from right-to-left, but we must generate # the instructions from left-to-right because we must calculate # instruction sizes from left-to-right. - my $arg_num = 0; for (my $word = 0; $word < @args_per_word; $word++) { my $ap = 0; # Argument number within word. my $packed_var = "tmp_packed" . ($word+1); @@ -1849,7 +1883,9 @@ sub do_pack_one { # Skip any unpackable arguments at the end. # while ($arg_num < @args) { - $skip_unpackable->($args[$arg_num]); + my $arg = $args[$arg_num]; + $skip_unpackable->($arg); + $size += $arg_size{$arg}; $arg_num++; } @@ -1935,8 +1971,10 @@ sub pack_score { # Less numbers of words give a higher score; for the same number of # words, using PACK_JUMP or PACK_IN_INSTR_WORD gives a lower score. - my $score = 1 + $max_spec_operands*($max_spec_operands - $size); - if ($options == PACK_IN_INSTR_WORD) { + my $score = 1 + 10*($max_spec_operands - $size); + if (($options & PACK_OPT_IN_INSTR_WORD) != 0) { + $score += 4; + } elsif ($options == PACK_IN_INSTR_WORD) { $score += 0; } elsif ($options == PACK_JUMP) { $score += 1; -- cgit v1.2.3 From a71ffb9c1b9de6ccc7b8d2278361474b373802c3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 3 Oct 2017 07:20:20 +0200 Subject: beam_makeops: Use named arguments for the code generation functions The number of arguments has become unwieldy. --- erts/emulator/utils/beam_makeops | 43 ++++++++++++++++++++++++++-------------- 1 file changed, 28 insertions(+), 15 deletions(-) (limited to 'erts') diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops index 9da62f18ac..50dd534828 100755 --- a/erts/emulator/utils/beam_makeops +++ b/erts/emulator/utils/beam_makeops @@ -529,7 +529,7 @@ sub emulator_output { my($name, $hotness, @args) = @$_; my $print_name = print_name($name, @args); - my($size, $code, $pack_spec) = cg_basic($name, @args); + my($size, $code, $pack_spec) = cg_basic(name => $name, args => \@args); if (defined $code) { $code = "OpCase($print_name):\n$code"; push @generated_code, [$hotness,$code,($print_name)]; @@ -1157,7 +1157,7 @@ sub combine_instruction_group { foreach (0..$#c_args) { push @first, shift @rest; } - my $size = cg_combined_size($s, @first); + my $size = cg_combined_size(name => $s, args => \@first); $offsets{$s} = $offset unless defined $offsets{$s} and $offsets{$s} < $offset; $offset += $size - 1; @@ -1248,8 +1248,12 @@ sub combine_instruction_group { } my($gen_code,$down,$up) = - cg_combined_code($s, $flags, $offset, - $group_size-$offset, $inc, @first); + cg_combined_code(name => $s, + extra_comments => $flags, + offset => $offset, + comp_size => $group_size-$offset, + inc => $inc, + args =>\@first); my $spec_label = "$opcase$label"; $down{$spec_label} = $down; $up{$spec_label} = $up; @@ -1298,8 +1302,8 @@ sub micro_label { # sub cg_basic { - my($name,@args) = @_; - my($size,$code,$pack_spec) = code_gen($name, \@extended_pack_options, '', 0, undef, undef, @args); + my %params = (@_, pack_options => \@extended_pack_options); + my($size,$code,$pack_spec) = code_gen(%params); $pack_spec = build_pack_spec($pack_spec); ($size,$code,$pack_spec); } @@ -1309,8 +1313,8 @@ sub cg_basic { # sub cg_combined_size { - my($name,@args) = @_; - my($size) = code_gen($name, \@basic_pack_options, '', 0, undef, undef, @args); + my %params = (@_, pack_options => \@basic_pack_options); + my($size) = code_gen(%params); $size; } @@ -1319,9 +1323,9 @@ sub cg_combined_size { # sub cg_combined_code { - my($name,$extra,$offset,$comp_size,$inc,@args) = @_; - my($size,$code,$pack_spec) = - code_gen($name, \@basic_pack_options, $extra, $offset, $comp_size, $inc, @args); + my %params = (@_, pack_options => \@basic_pack_options); + + my($size,$code,$pack_spec) = code_gen(%params); if ($pack_spec eq '') { ($code,'',''); } else { @@ -1331,8 +1335,16 @@ sub cg_combined_code { } sub code_gen { - my($name,$pack_options,$extra_comments,$offset,$comp_size,$inc,@args) = @_; - my $group_size = defined $comp_size ? $comp_size + $inc : undef; + my %params = (extra_comments => '', + offset => 0, + inc => 0, + @_); + my $name = $params{name}; + my $extra_comments = $params{extra_comments}; + my $offset = $params{offset}; + my $inc = $params{inc}; + my @args = @{$params{args}}; + my $size = 0; my $flags = ''; my @f; @@ -1347,6 +1359,7 @@ sub code_gen { my $c_code_ref = $c_code{$name}; if (defined $c_code_ref and $name ne 'catch') { + my $pack_options = $params{pack_options}; ($var_decls, $pack_spec, @args) = do_pack($name, $offset, $pack_options, @args); } @@ -1420,7 +1433,7 @@ sub code_gen { return ($size+1, undef, ''); } - $group_size = $size unless defined $group_size; + my $group_size = ($params{comp_size} || $size) + $inc; # # Generate main body of the implementation. @@ -1439,7 +1452,7 @@ sub code_gen { $bindings{$var} = $f[$i]; } $bindings{'NEXT_INSTRUCTION'} = "I+" . ($group_size+$offset+1); - $bindings{'IP_ADJUSTMENT'} = defined $inc ? $inc : 0; + $bindings{'IP_ADJUSTMENT'} = $inc; $c_code = eval { expand_all($c_code, \%bindings) }; unless (defined $c_code) { warn $@; -- cgit v1.2.3 From c2e746117b24235b8f2c508ef8f90e35ad422bf2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 4 Oct 2017 20:44:47 +0200 Subject: Pack operands for combined instructions into the instruction word The operands for the first part of a combined instruction (the entry point following the OpCase() label) can safely be packed into the instruction word. This commit will make each of the following instructions one word shorter: bs_context_to_binary_x i_band_xcjtd i_bs_get_binary_all_reuse_xft i_bs_get_integer_imm_xWtftx i_bs_get_integer_small_imm_xWftx i_bs_init_bits_fail_xjtx i_bs_init_bits_fail_yjtx i_bs_init_bits_fail_heap_sIjtx i_bs_init_bits_heap_WItx i_bs_init_fail_xjtx i_bs_init_fail_yjtx i_bs_init_fail_heap_sIjtx i_bs_init_heap_WItx i_bs_start_match2_xfttx i_bs_start_match2_yfttx i_element_xjsd i_element_yjsd i_fast_element_xjId i_fast_element_yjId i_increment_xWtd i_increment_yWtd i_jump_on_val_xfIW i_jump_on_val_yfIW i_jump_on_val_zero_xfI i_jump_on_val_zero_yfI i_minus_xxjtd i_plus_xxjtd i_plus_xyjtd i_put_tuple_xI i_put_tuple_yI i_rem_xxjtd i_select_tuple_arity_xfI i_select_tuple_arity_yfI i_select_tuple_arity2_xfAA i_select_tuple_arity2_yfAA i_select_val2_xfcc i_select_val2_yfcc i_select_val_bins_xfI i_select_val_bins_yfI i_select_val_lins_xfI i_select_val_lins_yfI --- erts/emulator/utils/beam_makeops | 41 +++++++++++++++++++++++++++++++--------- 1 file changed, 32 insertions(+), 9 deletions(-) (limited to 'erts') diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops index 50dd534828..d7791d23fa 100755 --- a/erts/emulator/utils/beam_makeops +++ b/erts/emulator/utils/beam_makeops @@ -1129,9 +1129,28 @@ sub combine_instruction_group { # Variables. my %offsets; my @instrs; - my %num_references; + my %num_references; # Number of references from other sub instructions. my $group_size = 999; + # + # Calculate the number of references from other sub instructions. + # This number is useful in several ways: + # + # * If this number is 0, it is only used as the entry point for a + # function, implying that it does not need a label and that operands + # can be packed into the instruction word. + # + # * We'll use this number in the sort key, as a tie breaker for sub instructions + # at the same instruction offset. + # + foreach my $ref_instr (@in_instrs) { + my(undef,undef,$first_sub,@other_subs) = @$ref_instr; + $num_references{$first_sub} += 0; # Make sure it is defined. + foreach my $sub (@other_subs) { + $num_references{$sub}++; + } + } + # Do basic error checking. Associate operands of instructions # with the correct micro instructions. Calculate offsets for micro # instructions. @@ -1157,12 +1176,13 @@ sub combine_instruction_group { foreach (0..$#c_args) { push @first, shift @rest; } - my $size = cg_combined_size(name => $s, args => \@first); + my $size = cg_combined_size(name => $s, + first => $num_references{$s} == 0, + args => \@first); $offsets{$s} = $offset unless defined $offsets{$s} and $offsets{$s} < $offset; $offset += $size - 1; my $label = micro_label($s); - $num_references{$label} = 0; push @new_subs, [$opcase,$label,$s,$size-1,@first]; $opcase = ''; } @@ -1181,9 +1201,8 @@ sub combine_instruction_group { my($opcase,$label,$s,$size,@args) = @{$subs[$i]}; my $next = ''; (undef,$next) = @{$subs[$i+1]} if $i < $#subs; - $num_references{$next}++ if $next; my $instr_info = "$opcase:$label:$next:$s:$size:@args"; - push @all_instrs, [$label,$offsets{$s},$instr_info]; + push @all_instrs, [$label,$s,$offsets{$s},$instr_info]; } } @@ -1191,8 +1210,8 @@ sub combine_instruction_group { my %label_to_offset; my %order_to_offset; foreach my $instr (@all_instrs) { - my($label,$offset,$instr_info) = @$instr; - my $sort_key = sprintf("%02d.%02d", $offset, $num_references{$label}); + my($label,$s,$offset,$instr_info) = @$instr; + my $sort_key = sprintf("%02d.%02d", $offset, $num_references{$s}); push @{$order_to_instrs{$sort_key}}, $instr_info; $label_to_offset{$label} = $offset; $order_to_offset{$sort_key} = $offset; @@ -1231,7 +1250,7 @@ sub combine_instruction_group { $gcode .= "OpCase($opcase):\n"; push @opcase_labels, $opcase; } - if ($num_references{$label}) { + if ($num_references{$s}) { $gcode .= "$label:\n"; } @@ -1249,6 +1268,7 @@ sub combine_instruction_group { my($gen_code,$down,$up) = cg_combined_code(name => $s, + first => $num_references{$s} == 0, extra_comments => $flags, offset => $offset, comp_size => $group_size-$offset, @@ -1314,6 +1334,8 @@ sub cg_basic { sub cg_combined_size { my %params = (@_, pack_options => \@basic_pack_options); + $params{pack_options} = \@extended_pack_options + if $params{first}; my($size) = code_gen(%params); $size; } @@ -1324,7 +1346,8 @@ sub cg_combined_size { sub cg_combined_code { my %params = (@_, pack_options => \@basic_pack_options); - + $params{pack_options} = \@extended_pack_options + if $params{first}; my($size,$code,$pack_spec) = code_gen(%params); if ($pack_spec eq '') { ($code,'',''); -- cgit v1.2.3