Sign Up
Log In
Log In
or
Sign Up
Places
All Projects
Status Monitor
Collapse sidebar
home:Ledest:erlang:23
erlang
2641-Refactor-the-transformation-engine.patch
Overview
Repositories
Revisions
Requests
Users
Attributes
Meta
File 2641-Refactor-the-transformation-engine.patch of Package erlang
From fb65455c92f8f8e9bcc8d6f7b8b7ca9738ff5c7e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= <bjorn@erlang.org> Date: Mon, 1 Jun 2020 08:27:09 +0200 Subject: [PATCH] Refactor the transformation engine The predicates (guard constraints) and generators for transformation rules were static functions the `beam_load.c` source code files. Break out the predicates and generators to `predicates.tab` and `generators.tab`, respectively. --- erts/emulator/Makefile.in | 12 +- erts/emulator/beam/beam_load.c | 2852 +------------------ erts/emulator/beam/beam_load.h | 313 ++ erts/emulator/beam/beam_transform_engine.c | 427 +++ erts/emulator/beam/beam_transform_helpers.c | 162 ++ erts/emulator/beam/beam_transform_helpers.h | 28 + erts/emulator/beam/float_instrs.tab | 10 - erts/emulator/beam/generators.tab | 1270 +++++++++ erts/emulator/beam/ops.tab | 89 +- erts/emulator/beam/predicates.tab | 269 ++ erts/emulator/internal_doc/beam_makeops.md | 103 +- erts/emulator/utils/beam_makeops | 118 +- 12 files changed, 2779 insertions(+), 2874 deletions(-) create mode 100644 erts/emulator/beam/beam_transform_engine.c create mode 100644 erts/emulator/beam/beam_transform_helpers.c create mode 100644 erts/emulator/beam/beam_transform_helpers.h create mode 100644 erts/emulator/beam/generators.tab create mode 100644 erts/emulator/beam/predicates.tab diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in index 6760207fa8..6c25a28116 100644 --- a/erts/emulator/Makefile.in +++ b/erts/emulator/Makefile.in @@ -29,13 +29,14 @@ 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@ CROSS_COMPILING = @CROSS_COMPILING@ NO_INLINE_FUNCTIONS=false OPCODE_TABLES = $(ERL_TOP)/lib/compiler/src/genop.tab \ beam/ops.tab \ +beam/predicates.tab \ +beam/generators.tab \ beam/macros.tab \ beam/instrs.tab \ beam/arith_instrs.tab \ @@ -45,7 +46,7 @@ beam/float_instrs.tab \ beam/map_instrs.tab \ beam/msg_instrs.tab \ beam/select_instrs.tab \ -beam/trace_instrs.tab +beam/trace_instrs.tab \ DEBUG_CFLAGS = @DEBUG_CFLAGS@ CONFIGURE_CFLAGS = @CFLAGS@ @@ -562,8 +563,7 @@ $(TTF_DIR)/beam_warm.h \ $(TTF_DIR)/beam_hot.h \ $(TTF_DIR)/beam_opcodes.c \ $(TTF_DIR)/beam_opcodes.h \ -$(TTF_DIR)/beam_pred_funcs.h \ -$(TTF_DIR)/beam_tr_funcs.h \ +$(TTF_DIR)/beam_transform.c \ : $(TTF_DIR)/OPCODES-GENERATED $(TTF_DIR)/OPCODES-GENERATED: $(OPCODE_TABLES) utils/beam_makeops $(gen_verbose)LANG=C $(PERL) utils/beam_makeops \ @@ -571,7 +571,6 @@ $(TTF_DIR)/OPCODES-GENERATED: $(OPCODE_TABLES) utils/beam_makeops -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) \ -emulator $(OPCODE_TABLES) && echo $? >$(TTF_DIR)/OPCODES-GENERATED GENERATE += $(TTF_DIR)/OPCODES-GENERATED @@ -864,6 +863,9 @@ PROFILE_OBJS = $(OBJDIR)/beam_emu.o $(OBJDIR)/erl_process.o EMU_OBJS = \ $(OBJDIR)/beam_opcodes.o \ + $(OBJDIR)/beam_transform.o \ + $(OBJDIR)/beam_transform_engine.o \ + $(OBJDIR)/beam_transform_helpers.o \ $(OBJDIR)/beam_load.o $(OBJDIR)/beam_bif_load.o \ $(OBJDIR)/beam_debug.o $(OBJDIR)/beam_bp.o \ $(OBJDIR)/beam_catches.o $(OBJDIR)/code_ix.o \ diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index 7d81ef268a..b5cf78c35d 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -51,111 +51,10 @@ ErlDrvBinary* erts_gzinflate_buffer(char*, int); -#define MAX_OPARGS 8 #define CALLED 0 #define DEFINED 1 #define EXPORTED 2 -#if defined(WORDS_BIGENDIAN) -# define NATIVE_ENDIAN(F) \ - if ((F).val & BSF_NATIVE) { \ - (F).val &= ~(BSF_LITTLE|BSF_NATIVE); \ - } else {} -#else -# define NATIVE_ENDIAN(F) \ - if ((F).val & BSF_NATIVE) { \ - (F).val &= ~BSF_NATIVE; \ - (F).val |= BSF_LITTLE; \ - } else {} -#endif - -/* - * Errors returned from tranform_engine(). - */ -#define TE_OK 0 -#define TE_FAIL (-1) -#define TE_SHORT_WINDOW (-2) - -/* - * Type for a reference to a label that must be patched. - */ - -typedef struct { - Uint pos; /* Position of label reference to patch. */ - Uint offset; /* Offset from patch location. */ - int packed; /* 0 (not packed), 1 (lsw), 2 (msw) */ -} LabelPatch; - -/* - * Type for a label. - */ - -typedef struct { - Uint value; /* Value of label (0 if not known yet). */ - Uint looprec_targeted; /* Non-zero if this label is the target of a loop_rec - * instruction. - */ - LabelPatch* patches; /* Array of label patches. */ - Uint num_patches; /* Number of patches in array. */ - Uint num_allocated; /* Number of allocated patches. */ -} Label; - -/* - * Type for an operand for a generic instruction. - */ - -typedef struct { - unsigned type; /* Type of operand. */ - BeamInstr val; /* Value of operand. */ -} GenOpArg; - -/* - * A generic operation. - */ - -typedef struct genop { - unsigned int op; /* Opcode. */ - int arity; /* Number of arguments. */ - GenOpArg def_args[MAX_OPARGS]; /* Default buffer for arguments. */ - GenOpArg* a; /* The arguments. */ - struct genop* next; /* Next genop. */ -} GenOp; - -/* - * The allocation unit for generic blocks. - */ - -typedef struct genop_block { - GenOp genop[32]; - struct genop_block* next; -} GenOpBlock; - -/* - * This structure contains information for an imported function or BIF. - */ -typedef struct { - Eterm module; /* Tagged atom for module. */ - Eterm function; /* Tagged atom for function. */ - int arity; /* Arity. */ - Uint patches; /* Index to locations in code to - * eventually patch with a pointer into - * the export entry. - */ - Export *bif; /* Pointer to export entry if BIF; - * NULL otherwise. - */ -} ImportEntry; - -/* - * This structure contains information for a function exported from a module. - */ - -typedef struct { - Eterm function; /* Tagged atom for function. */ - int arity; /* Arity. */ - BeamInstr* address; /* Address to function in code. */ -} ExportEntry; - #define MakeIffId(a, b, c, d) \ (((Uint) (a) << 24) | ((Uint) (b) << 16) | ((Uint) (c) << 8) | (Uint) (d)) @@ -174,13 +73,11 @@ typedef struct { #define LINE_CHUNK 9 #define UTF8_ATOM_CHUNK 10 -#define NUM_CHUNK_TYPES (sizeof(chunk_types)/sizeof(chunk_types[0])) - /* * An array with all chunk types recognized by the loader. */ -static Uint chunk_types[] = { +static Uint chunk_types[ERTS_BEAM_NUM_CHUNK_TYPES] = { /* * Atom chunk types -- Atom or AtU8 MUST be present. */ @@ -205,172 +102,6 @@ static Uint chunk_types[] = { MakeIffId('A', 't', 'U', '8'), /* 10 */ }; -/* - * This structure keeps load-time information about a lambda. - */ - -typedef struct { - ErlFunEntry* fe; /* Entry in fun table. */ - unsigned label; /* Label of function entry. */ - Uint32 num_free; /* Number of free variables. */ - Eterm function; /* Name of local function. */ - int arity; /* Arity (including free variables). */ -} Lambda; - -/* - * This structure keeps load-time information about a literal. - */ - -typedef struct { - Eterm term; /* The tagged term (in the heap). */ - ErlHeapFragment* heap_frags; -} Literal; - -/* - * This structure keeps information about an operand that needs to be - * patched to contain the correct address of a literal when the code is - * frozen. - */ - -typedef struct literal_patch LiteralPatch; -struct literal_patch { - Uint pos; /* Position in code */ - LiteralPatch* next; -}; - -/* - * This structure keeps information about an operand that needs to be - * patched to contain the correct address for an address into the string table. - */ - -typedef struct string_patch StringPatch; -struct string_patch { - int pos; /* Position in code */ - StringPatch* next; -}; - -/* - * This structure associates a code offset with a source code location. - */ - -typedef struct { - int pos; /* Position in code */ - Uint32 loc; /* Location in source code */ -} LineInstr; - -/* - * This structure contains all information about the module being loaded. - */ -#define MD5_SIZE 16 -typedef struct LoaderState { - /* - * The current logical file within the binary. - */ - - char* file_name; /* Name of file we are reading (usually chunk name). */ - byte* file_p; /* Current pointer within file. */ - unsigned file_left; /* Number of bytes left in file. */ - ErlDrvBinary* bin; /* Binary holding BEAM file (or NULL) */ - - /* - * The following are used mainly for diagnostics. - */ - - Eterm group_leader; /* Group leader (for diagnostics). */ - Eterm module; /* Tagged atom for module name. */ - Eterm function; /* Tagged atom for current function - * (or 0 if none). - */ - unsigned arity; /* Arity for current function. */ - - /* - * All found chunks. - */ - - struct { - byte* start; /* Start of chunk (in binary). */ - unsigned size; /* Size of chunk. */ - } chunks[NUM_CHUNK_TYPES]; - - /* - * Used for code loading (mainly). - */ - - byte* code_start; /* Start of code file. */ - unsigned code_size; /* Size of code file. */ - int specific_op; /* Specific opcode (-1 if not found). */ - unsigned int num_functions; /* Number of functions in module. */ - unsigned int num_labels; /* Number of labels. */ - BeamCodeHeader* hdr; /* Loaded code header */ - BeamInstr* codev; /* Loaded code buffer */ - int codev_size; /* Size of code buffer in words. */ - int ci; /* Current index into loaded code buffer. */ - Label* labels; - StringPatch* string_patches; /* Linked list of position into string table to patch. */ - BeamInstr catches; /* Linked list of catch_yf instructions. */ - unsigned loaded_size; /* Final size of code when loaded. */ - byte mod_md5[MD5_SIZE]; /* MD5 for module code. */ - int may_load_nif; /* true if NIFs may later be loaded for this module */ - int on_load; /* Index in the code for the on_load function - * (or 0 if there is no on_load function) - */ - int otp_20_or_higher; /* Compiled with OTP 20 or higher */ - unsigned max_opcode; /* Highest opcode used in module */ - - /* - * Atom table. - */ - - unsigned int num_atoms; /* Number of atoms in atom table. */ - Eterm* atom; /* Atom table. */ - - unsigned int num_exps; /* Number of exports. */ - ExportEntry* export; /* Pointer to export table. */ - - unsigned int num_imports; /* Number of imports. */ - ImportEntry* import; /* Import entry (translated information). */ - - /* - * Generic instructions. - */ - GenOp* genop; /* The last generic instruction seen. */ - GenOp* free_genop; /* List of free genops. */ - GenOpBlock* genop_blocks; /* List of all block of allocated genops. */ - - /* - * Lambda table. - */ - - unsigned int num_lambdas; /* Number of lambdas in table. */ - unsigned int lambdas_allocated; /* Size of allocated lambda table. */ - Lambda* lambdas; /* Pointer to lambdas. */ - Lambda def_lambdas[16]; /* Default storage for lambda table. */ - char* lambda_error; /* Delayed missing 'FunT' error. */ - - /* - * Literals (constant pool). - */ - - unsigned int num_literals; /* Number of literals in table. */ - unsigned int allocated_literals; /* Number of literal entries allocated. */ - Literal* literals; /* Array of literals. */ - LiteralPatch* literal_patches; /* Operands that need to be patched. */ - Uint total_literal_size; /* Total heap size for all literals. */ - - /* - * Line table. - */ - BeamInstr* line_item; /* Line items from the BEAM file. */ - unsigned int num_line_items;/* Number of line items. */ - LineInstr* line_instr; /* Line instructions */ - unsigned int num_line_instrs; /* Maximum number of line instructions */ - unsigned int current_li; /* Current line instruction */ - unsigned int* func_line; /* Mapping from function to first line instr */ - Eterm* fname; /* List of file names */ - unsigned int num_fnames; /* Number of filenames in fname table */ - int loc_size; /* Size of location info in bytes (2/4) */ -} LoaderState; - #define GetTagAndValue(Stp, Tag, Val) \ do { \ BeamInstr __w; \ @@ -458,25 +189,7 @@ typedef struct LoaderState { LoadError2((Stp), "bad atom index %d in %s", (Index), stp->file_name); \ } -#ifdef DEBUG -# define GARBAGE 0xCC -# define DEBUG_INIT_GENOP(Dst) sys_memset(Dst, GARBAGE, sizeof(GenOp)) -#else -# define DEBUG_INIT_GENOP(Dst) -#endif - -#define NEW_GENOP(Stp, Dst) \ - do { \ - if ((Stp)->free_genop == NULL) { \ - new_genop((Stp)); \ - } \ - Dst = (Stp)->free_genop; \ - (Stp)->free_genop = (Stp)->free_genop->next; \ - DEBUG_INIT_GENOP(Dst); \ - (Dst)->a = (Dst)->def_args; \ - } while (0) - -#define FREE_GENOP(Stp, Genop) \ +#define FREE_GENOP(Stp, Genop) \ do { \ if ((Genop)->a != (Genop)->def_args) { \ erts_free(ERTS_ALC_T_LOADER_TMP, (Genop)->a); \ @@ -485,20 +198,6 @@ typedef struct LoaderState { (Stp)->free_genop = (Genop); \ } while (0) -#define GENOP_ARITY(Genop, Arity) \ - do { \ - ASSERT((Genop)->a == (Genop)->def_args); \ - (Genop)->arity = (Arity); \ - (Genop)->a = erts_alloc(ERTS_ALC_T_LOADER_TMP, \ - (Genop)->arity * sizeof(GenOpArg)); \ - } while (0) - -#define GENOP_NAME_ARITY(Genop, Name, Arity) \ - do { \ - (Genop)->op = genop_##Name##_##Arity; \ - (Genop)->arity = Arity; \ - } while (0) - static void free_loader_state(Binary* magic); static ErlHeapFragment* new_literal_fragment(Uint size); static void free_literal_fragment(ErlHeapFragment*); @@ -523,38 +222,17 @@ static int read_line_table(LoaderState* stp); static int read_code_header(LoaderState* stp); static void init_label(Label* lp); static int load_code(LoaderState* stp); -static GenOp* gen_element(LoaderState* stp, GenOpArg Fail, GenOpArg Index, - GenOpArg Tuple, GenOpArg Dst); -static GenOp* gen_split_values(LoaderState* stp, GenOpArg S, - GenOpArg TypeFail, GenOpArg Fail, - GenOpArg Size, GenOpArg* Rest); -static GenOp* gen_select_val(LoaderState* stp, GenOpArg S, GenOpArg Fail, - GenOpArg Size, GenOpArg* Rest); -static GenOp* gen_select_literals(LoaderState* stp, GenOpArg S, - GenOpArg Fail, GenOpArg Size, - GenOpArg* Rest); -static GenOp* const_select_val(LoaderState* stp, GenOpArg S, GenOpArg Fail, - GenOpArg Size, GenOpArg* Rest); - -static GenOp* gen_get_map_element(LoaderState* stp, GenOpArg Fail, GenOpArg Src, - GenOpArg Size, GenOpArg* Rest); static int freeze_code(LoaderState* stp); static void final_touch(LoaderState* stp, struct erl_module_instance* inst_p); static void short_file(int line, LoaderState* stp, unsigned needed); static void load_printf(int line, LoaderState* context, char *fmt, ...); -static int transform_engine(LoaderState* st); static void id_to_string(Uint id, char* s); -static void new_genop(LoaderState* stp); static int get_tag_and_value(LoaderState* stp, Uint len_code, unsigned tag, BeamInstr* result); -static int new_label(LoaderState* stp); static void new_literal_patch(LoaderState* stp, int pos); static void new_string_patch(LoaderState* stp, int pos); -static int find_literal(LoaderState* stp, Eterm needle, Uint *idx); -static Uint new_literal(LoaderState* stp, Eterm** hpp, Uint heap_size); -static int genopargcompare(GenOpArg* a, GenOpArg* b); static Eterm get_module_info(Process* p, ErtsCodeIndex code_ix, BeamCodeHeader*, Eterm module, Eterm what); static Eterm exported_from_module(Process* p, ErtsCodeIndex code_ix, @@ -566,7 +244,6 @@ static Eterm compilation_info_for_module(Process* p, BeamCodeHeader*); static Eterm md5_of_module(Process* p, BeamCodeHeader*); static Eterm has_native(BeamCodeHeader*); static Eterm native_addresses(Process* p, BeamCodeHeader*); -static int safe_mul(UWord a, UWord b, UWord* resp); static int must_swap_floats; @@ -653,7 +330,7 @@ erts_prepare_loading(Binary* magic, Process *c_p, Eterm group_leader, CHKALLOC(); CHKBLK(ERTS_ALC_T_CODE,stp->code); if (!init_iff_file(stp, code, unloaded_size) || - !scan_iff_file(stp, chunk_types, NUM_CHUNK_TYPES) || + !scan_iff_file(stp, chunk_types, ERTS_BEAM_NUM_CHUNK_TYPES) || !verify_chunks(stp)) { goto load_error; } @@ -2027,7 +1704,7 @@ load_code(LoaderState* stp) arity = gen_opc[last_op->op].arity; last_op->arity = 0; - ASSERT(arity <= MAX_OPARGS); + ASSERT(arity <= ERTS_BEAM_MAX_OPARGS); for (arg = 0; arg < arity; arg++) { GetTagAndValue(stp, last_op->a[arg].type, last_op->a[arg].val); @@ -2177,7 +1854,7 @@ load_code(LoaderState* stp) */ goto get_next_instr; } - switch (transform_engine(stp)) { + switch (erts_transform_engine(stp)) { case TE_FAIL: /* * No transformation found. stp->genop != NULL and @@ -2585,7 +2262,7 @@ load_code(LoaderState* stp) sp->patch_pos = 0; for (lp = stp->literal_patches; - lp && lp->pos > ci-MAX_OPARGS; + lp && lp->pos > ci - ERTS_BEAM_MAX_OPARGS; lp = lp->next) { if (lp->pos == ci) { sp->patch_pos = &lp->pos; @@ -2981,2008 +2658,116 @@ load_code(LoaderState* stp) return retval; } -#define succ(St, X, Y) ((X).type == (Y).type && (X).val + 1 == (Y).val) -#define succ2(St, X, Y) ((X).type == (Y).type && (X).val + 2 == (Y).val) -#define succ3(St, X, Y) ((X).type == (Y).type && (X).val + 3 == (Y).val) -#define succ4(St, X, Y) ((X).type == (Y).type && (X).val + 4 == (Y).val) - -#define offset(St, X, Y, Offset) ((X).type == (Y).type && (X).val + Offset == (Y).val) - -#ifdef NO_FPE_SIGNALS -#define no_fpe_signals(St) 1 -#else -#define no_fpe_signals(St) 0 -#endif - -#define never(St) 0 - -static int -compiled_with_otp_20_or_higher(LoaderState* stp) -{ - return stp->otp_20_or_higher; -} - /* - * Predicate that tests whether the following two moves are independent: - * - * move Src1 Dst1 - * move Src2 Dst2 - * + * Freeze the code in memory, move the string table into place, + * resolve all labels. */ -static int -independent_moves(LoaderState* stp, GenOpArg Src1, GenOpArg Dst1, - GenOpArg Src2, GenOpArg Dst2) -{ - return (Src1.type != Dst2.type || Src1.val != Dst2.val) && - (Src2.type != Dst1.type || Src2.val != Dst1.val) && - (Dst1.type != Dst2.type ||Dst1.val != Dst2.val); -} -/* - * Predicate that tests that two registers are distinct. - * - * move Src1 Dst1 - * move Src2 Dst2 - * - */ static int -distinct(LoaderState* stp, GenOpArg Reg1, GenOpArg Reg2) +freeze_code(LoaderState* stp) { - return Reg1.type != Reg2.type || Reg1.val != Reg2.val; -} - -/* - * Predicate that tests whether a jump table can be used. - */ + BeamCodeHeader* code_hdr = stp->hdr; + BeamInstr* codev = (BeamInstr*) &stp->hdr->functions; + int i; + byte* str_table; + unsigned strtab_size = stp->chunks[STR_CHUNK].size; + unsigned attr_size = stp->chunks[ATTR_CHUNK].size; + unsigned compile_size = stp->chunks[COMPILE_CHUNK].size; + Uint size; + Sint decoded_size; + Uint line_size; -static int -use_jump_tab(LoaderState* stp, GenOpArg Size, GenOpArg* Rest) -{ - Sint min, max; - Sint i; + /* + * Verify that there was a correct 'FunT' chunk if there were + * make_fun2 instructions in the file. + */ - if (Size.val < 2 || Size.val % 2 != 0) { - return 0; + if (stp->lambda_error != NULL) { + LoadError0(stp, stp->lambda_error); } - /* we may be called with sequences of tagged fixnums or atoms; - return early in latter case, before we access the values */ - if (Rest[0].type != TAG_i || Rest[1].type != TAG_f) - return 0; - min = max = Rest[0].val; - for (i = 2; i < Size.val; i += 2) { - if (Rest[i].type != TAG_i || Rest[i+1].type != TAG_f) { - return 0; - } - if (Rest[i].val < min) { - min = Rest[i].val; - } else if (max < Rest[i].val) { - max = Rest[i].val; - } + /* + * Calculate the final size of the code. + */ + if (stp->line_instr == 0) { + line_size = 0; + } else { + line_size = (offsetof(BeamCodeLineTab,func_tab) + + (stp->num_functions + 1) * sizeof(BeamInstr**) /* func_tab */ + + (stp->current_li + 1) * sizeof(BeamInstr*) /* line items */ + + stp->num_fnames * sizeof(Eterm) /* fname table */ + + (stp->current_li + 1) * stp->loc_size); /* loc_tab */ } + size = offsetof(BeamCodeHeader,functions) + (stp->ci * sizeof(BeamInstr)) + + strtab_size + attr_size + compile_size + MD5_SIZE + line_size; - return max - min <= Size.val; -} + /* + * Move the code to its final location. + */ -/* - * Predicate to test whether all values in a table are either - * floats or bignums. - */ + code_hdr = (BeamCodeHeader*) erts_realloc(ERTS_ALC_T_CODE, (void *) code_hdr, size); + codev = (BeamInstr*) &code_hdr->functions; + CHKBLK(ERTS_ALC_T_CODE,code_hdr); + /* + * Place a pointer to the op_int_code_end instruction in the + * function table in the beginning of the file. + */ -static int -floats_or_bignums(LoaderState* stp, GenOpArg Size, GenOpArg* Rest) -{ - int i; + code_hdr->functions[stp->num_functions] = (ErtsCodeInfo*)(codev + stp->ci - 1); + CHKBLK(ERTS_ALC_T_CODE,code_hdr); - if (Size.val < 2 || Size.val % 2 != 0) { - return 0; - } + /* + * Store the pointer to the on_load function. + */ - for (i = 0; i < Size.val; i += 2) { - if (Rest[i].type != TAG_q) { - return 0; - } - if (Rest[i+1].type != TAG_f) { - return 0; - } + if (stp->on_load) { + code_hdr->on_load_function_ptr = codev + stp->on_load; + } else { + code_hdr->on_load_function_ptr = NULL; } + CHKBLK(ERTS_ALC_T_CODE,code_hdr); - return 1; -} - - -/* - * Predicate to test whether all values in a table have a fixed size. - */ + /* + * Place the literals in their own allocated heap (for fast range check) + * and fix up all instructions that refer to it. + */ + { + Eterm* ptr; + LiteralPatch* lp; + ErlOffHeap code_off_heap; + ErtsLiteralArea *literal_area; + Uint lit_asize; -static int -fixed_size_values(LoaderState* stp, GenOpArg Size, GenOpArg* Rest) -{ - int i; + ERTS_INIT_OFF_HEAP(&code_off_heap); - if (Size.val < 2 || Size.val % 2 != 0) { - return 0; - } + lit_asize = ERTS_LITERAL_AREA_ALLOC_SIZE(stp->total_literal_size); + literal_area = erts_alloc(ERTS_ALC_T_LITERAL, lit_asize); + ptr = &literal_area->start[0]; + literal_area->end = ptr + stp->total_literal_size; - for (i = 0; i < Size.val; i += 2) { - if (Rest[i+1].type != TAG_f) - return 0; - switch (Rest[i].type) { - case TAG_a: - case TAG_i: - case TAG_v: - break; - case TAG_q: - return is_float(stp->literals[Rest[i].val].term); - default: - return 0; + for (i = 0; i < stp->num_literals; i++) { + if (is_not_immed(stp->literals[i].term)) { + erts_move_multi_frags(&ptr, &code_off_heap, + stp->literals[i].heap_frags, + &stp->literals[i].term, 1, 1); + ASSERT(erts_is_literal(stp->literals[i].term, + ptr_val(stp->literals[i].term))); + } } - } - - return 1; -} - -static int -mixed_types(LoaderState* stp, GenOpArg Size, GenOpArg* Rest) -{ - int i; - Uint type; - - if (Size.val < 2 || Size.val % 2 != 0) { - return 0; - } + literal_area->off_heap = code_off_heap.first; + lp = stp->literal_patches; + while (lp != 0) { + BeamInstr* op_ptr; + Literal* lit; - type = Rest[0].type; - for (i = 0; i < Size.val; i += 2) { - if (Rest[i].type != type) - return 1; + op_ptr = codev + lp->pos; + lit = &stp->literals[op_ptr[0]]; + op_ptr[0] = lit->term; + lp = lp->next; + } + code_hdr->literal_area = literal_area; } - - return 0; -} - -/* - * Test whether register Reg is killed by make_fun instruction that - * creates the fun given by index idx. - */ - -static int -is_killed_by_make_fun(LoaderState* stp, GenOpArg Reg, GenOpArg idx) -{ - Uint num_free; - - if (idx.val >= stp->num_lambdas) { - /* Invalid index. Ignore the error for now. */ - return 0; - } else { - num_free = stp->lambdas[idx.val].num_free; - return Reg.type == TAG_x && num_free <= Reg.val; - } -} - -/* Test whether Bif is "heavy" and should always go through its export entry */ -static int -is_heavy_bif(LoaderState* stp, GenOpArg Bif) -{ - Export *ep; - - if (Bif.type != TAG_u || Bif.val >= stp->num_imports) { - return 0; - } - - ep = stp->import[Bif.val].bif; - - if (ep) { - return bif_table[ep->bif_number].kind == BIF_KIND_HEAVY; - } - - return 0; -} - -/* - * Generate an instruction for element/2. - */ - -static GenOp* -gen_element(LoaderState* stp, GenOpArg Fail, GenOpArg Index, - GenOpArg Tuple, GenOpArg Dst) -{ - GenOp* op; - - NEW_GENOP(stp, op); - op->next = NULL; - - if (Index.type == TAG_i && Index.val > 0 && - Index.val <= ERTS_MAX_TUPLE_SIZE && - (Tuple.type == TAG_x || Tuple.type == TAG_y)) { - GENOP_NAME_ARITY(op, i_fast_element, 4); - 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 { - GENOP_NAME_ARITY(op, i_element, 4); - op->a[0] = Tuple; - op->a[1] = Fail; - op->a[2] = Index; - op->a[3] = Dst; - } - - return op; -} - -static GenOp* -gen_bs_save(LoaderState* stp, GenOpArg Reg, GenOpArg Index) -{ - GenOp* op; - - NEW_GENOP(stp, op); - GENOP_NAME_ARITY(op, i_bs_save2, 2); - op->a[0] = Reg; - op->a[1] = Index; - if (Index.type == TAG_u) { - op->a[1].val = Index.val+1; - } else if (Index.type == TAG_a && Index.val == am_start) { - op->a[1].type = TAG_u; - op->a[1].val = 0; - } - op->next = NULL; - return op; -} - -static GenOp* -gen_bs_restore(LoaderState* stp, GenOpArg Reg, GenOpArg Index) -{ - GenOp* op; - - NEW_GENOP(stp, op); - GENOP_NAME_ARITY(op, i_bs_restore2, 2); - op->a[0] = Reg; - op->a[1] = Index; - if (Index.type == TAG_u) { - op->a[1].val = Index.val+1; - } else if (Index.type == TAG_a && Index.val == am_start) { - op->a[1].type = TAG_u; - op->a[1].val = 0; - } - op->next = NULL; - return op; -} - -/* - * Generate the fastest instruction to fetch an integer from a binary. - */ - -static GenOp* -gen_get_integer2(LoaderState* stp, GenOpArg Fail, GenOpArg Ms, GenOpArg Live, - GenOpArg Size, GenOpArg Unit, - GenOpArg Flags, GenOpArg Dst) -{ - GenOp* op; - UWord bits; - - NEW_GENOP(stp, op); - - NATIVE_ENDIAN(Flags); - if (Size.type == TAG_i) { - if (!safe_mul(Size.val, Unit.val, &bits)) { - goto error; - } else if ((Flags.val & BSF_SIGNED) != 0) { - goto generic; - } else if (bits == 8) { - GENOP_NAME_ARITY(op, i_bs_get_integer_8, 3); - op->a[0] = Ms; - op->a[1] = Fail; - op->a[2] = Dst; - } else if (bits == 16 && (Flags.val & BSF_LITTLE) == 0) { - GENOP_NAME_ARITY(op, i_bs_get_integer_16, 3); - op->a[0] = Ms; - op->a[1] = Fail; - op->a[2] = Dst; -#ifdef ARCH_64 - } else if (bits == 32 && (Flags.val & BSF_LITTLE) == 0) { - GENOP_NAME_ARITY(op, i_bs_get_integer_32, 3); - op->a[0] = Ms; - op->a[1] = Fail; - op->a[2] = Dst; -#endif - } else { - generic: - if (bits < SMALL_BITS) { - GENOP_NAME_ARITY(op, i_bs_get_integer_small_imm, 5); - op->a[0] = Ms; - op->a[1].type = TAG_u; - op->a[1].val = bits; - op->a[2] = Fail; - op->a[3] = Flags; - op->a[4] = Dst; - } else { - GENOP_NAME_ARITY(op, i_bs_get_integer_imm, 6); - op->a[0] = Ms; - op->a[1].type = TAG_u; - op->a[1].val = bits; - op->a[2] = Live; - op->a[3] = Fail; - op->a[4] = Flags; - op->a[5] = Dst; - } - } - } else if (Size.type == TAG_q) { - Eterm big = stp->literals[Size.val].term; - Uint bigval; - - if (!term_to_Uint(big, &bigval)) { - error: - GENOP_NAME_ARITY(op, jump, 1); - op->a[0] = Fail; - } else { - if (!safe_mul(bigval, Unit.val, &bits)) { - goto error; - } - goto generic; - } - } else if (Size.type == TAG_x || Size.type == TAG_y) { - GENOP_NAME_ARITY(op, i_bs_get_integer, 6); - op->a[0] = Ms; - op->a[1] = Fail; - op->a[2] = Live; - op->a[3].type = TAG_u; - op->a[3].val = (Unit.val << 3) | Flags.val; - op->a[4] = Size; - op->a[5] = Dst; - op->next = NULL; - return op; - } else { - /* Invalid literal size. */ - goto error; - } - op->next = NULL; - return op; -} - -/* - * Generate the fastest instruction to fetch a binary from a binary. - */ - -static GenOp* -gen_get_binary2(LoaderState* stp, GenOpArg Fail, GenOpArg Ms, GenOpArg Live, - GenOpArg Size, GenOpArg Unit, - GenOpArg Flags, GenOpArg Dst) -{ - GenOp* op; - NEW_GENOP(stp, op); - - NATIVE_ENDIAN(Flags); - if (Size.type == TAG_a && Size.val == am_all) { - GENOP_NAME_ARITY(op, i_bs_get_binary_all2, 5); - op->a[0] = Ms; - op->a[1] = Fail; - op->a[2] = Live; - op->a[3] = Unit; - op->a[4] = Dst; - } else if (Size.type == TAG_i) { - GENOP_NAME_ARITY(op, i_bs_get_binary_imm2, 6); - op->a[0] = Ms; - op->a[1] = Fail; - op->a[2] = Live; - op->a[3].type = TAG_u; - if (!safe_mul(Size.val, Unit.val, &op->a[3].val)) { - goto error; - } - op->a[4] = Flags; - op->a[5] = Dst; - } else if (Size.type == TAG_q) { - Eterm big = stp->literals[Size.val].term; - Uint bigval; - - if (!term_to_Uint(big, &bigval)) { - error: - GENOP_NAME_ARITY(op, jump, 1); - op->a[0] = Fail; - } else { - GENOP_NAME_ARITY(op, i_bs_get_binary_imm2, 6); - op->a[0] = Ms; - op->a[1] = Fail; - op->a[2] = Live; - op->a[3].type = TAG_u; - if (!safe_mul(bigval, Unit.val, &op->a[3].val)) { - goto error; - } - op->a[4] = Flags; - op->a[5] = Dst; - } - } else if (Size.type == TAG_x || Size.type == TAG_y) { - GENOP_NAME_ARITY(op, i_bs_get_binary2, 6); - op->a[0] = Ms; - op->a[1] = Fail; - op->a[2] = Live; - op->a[3] = Size; - op->a[4].type = TAG_u; - op->a[4].val = (Unit.val << 3) | Flags.val; - op->a[5] = Dst; - } else { - /* Invalid literal size. */ - goto error; - } - op->next = NULL; - return op; -} - -/* - * Predicate to test whether a binary construction is too big. - */ - -static int -binary_too_big(LoaderState* stp, GenOpArg Size) -{ - return Size.type == TAG_o || - (Size.type == TAG_u && ((Size.val >> (8*sizeof(Uint)-3)) != 0)); -} - -static GenOp* -gen_put_binary(LoaderState* stp, GenOpArg Fail,GenOpArg Size, - GenOpArg Unit, GenOpArg Flags, GenOpArg Src) -{ - GenOp* op; - NEW_GENOP(stp, op); - - NATIVE_ENDIAN(Flags); - if (Size.type == TAG_a && Size.val == am_all) { - GENOP_NAME_ARITY(op, i_new_bs_put_binary_all, 3); - op->a[0] = Src; - op->a[1] = Fail; - op->a[2] = Unit; - } else if (Size.type == TAG_i) { - GENOP_NAME_ARITY(op, i_new_bs_put_binary_imm, 3); - op->a[0] = Fail; - op->a[1].type = TAG_u; - if (safe_mul(Size.val, Unit.val, &op->a[1].val)) { - op->a[2] = Src; - } else { - error: - GENOP_NAME_ARITY(op, badarg, 1); - op->a[0] = Fail; - } - } else if (Size.type == TAG_q) { -#ifdef ARCH_64 - /* - * There is no way that this binary would fit in memory. - */ - goto error; -#else - Eterm big = stp->literals[Size.val].term; - Uint bigval; - Uint size; - - if (!term_to_Uint(big, &bigval) || - !safe_mul(bigval, Unit.val, &size)) { - goto error; - } - GENOP_NAME_ARITY(op, i_new_bs_put_binary_imm, 3); - op->a[0] = Fail; - op->a[1].type = TAG_u; - op->a[1].val = size; - op->a[2] = Src; -#endif - } else { - GENOP_NAME_ARITY(op, i_new_bs_put_binary, 4); - op->a[0] = Fail; - op->a[1] = Size; - op->a[2].type = TAG_u; - op->a[2].val = (Unit.val << 3) | (Flags.val & 7); - op->a[3] = Src; - } - - op->next = NULL; - return op; -} - -static GenOp* -gen_put_integer(LoaderState* stp, GenOpArg Fail, GenOpArg Size, - GenOpArg Unit, GenOpArg Flags, GenOpArg Src) -{ - GenOp* op; - NEW_GENOP(stp, op); - - NATIVE_ENDIAN(Flags); - /* Negative size must fail */ - if (Size.type == TAG_i) { - Uint size; - if (!safe_mul(Size.val, Unit.val, &size)) { - error: - GENOP_NAME_ARITY(op, badarg, 1); - op->a[0] = Fail; - op->next = NULL; - return op; - } - GENOP_NAME_ARITY(op, i_new_bs_put_integer_imm, 4); - op->a[0] = Src; - op->a[1] = Fail; - op->a[2].type = TAG_u; - op->a[2].val = size; - op->a[3].type = Flags.type; - op->a[3].val = (Flags.val & 7); - } else if (Size.type == TAG_q) { - Eterm big = stp->literals[Size.val].term; - Uint bigval; - Uint size; - - if (!term_to_Uint(big, &bigval) || - !safe_mul(bigval, Unit.val, &size)) { - goto error; - } - GENOP_NAME_ARITY(op, i_new_bs_put_integer_imm, 4); - op->a[0] = Src; - op->a[1] = Fail; - op->a[2].type = TAG_u; - op->a[2].val = size; - op->a[3].type = Flags.type; - op->a[3].val = (Flags.val & 7); - } else { - GENOP_NAME_ARITY(op, i_new_bs_put_integer, 4); - op->a[0] = Fail; - op->a[1] = Size; - op->a[2].type = TAG_u; - op->a[2].val = (Unit.val << 3) | (Flags.val & 7); - op->a[3] = Src; - } - op->next = NULL; - return op; -} - -static GenOp* -gen_put_float(LoaderState* stp, GenOpArg Fail, GenOpArg Size, - GenOpArg Unit, GenOpArg Flags, GenOpArg Src) -{ - GenOp* op; - NEW_GENOP(stp, op); - - NATIVE_ENDIAN(Flags); - if (Size.type == TAG_i) { - GENOP_NAME_ARITY(op, i_new_bs_put_float_imm, 4); - op->a[0] = Fail; - op->a[1].type = TAG_u; - if (!safe_mul(Size.val, Unit.val, &op->a[1].val)) { - GENOP_NAME_ARITY(op, badarg, 1); - op->a[0] = Fail; - } else { - op->a[2] = Flags; - op->a[3] = Src; - } - } else { - GENOP_NAME_ARITY(op, i_new_bs_put_float, 4); - op->a[0] = Fail; - op->a[1] = Size; - op->a[2].type = TAG_u; - op->a[2].val = (Unit.val << 3) | (Flags.val & 7); - op->a[3] = Src; - } - op->next = NULL; - return op; -} - -/* - * Generate an instruction to fetch a float from a binary. - */ - -static GenOp* -gen_get_float2(LoaderState* stp, GenOpArg Fail, GenOpArg Ms, GenOpArg Live, - GenOpArg Size, GenOpArg Unit, GenOpArg Flags, GenOpArg Dst) -{ - GenOp* op; - NEW_GENOP(stp, op); - - NATIVE_ENDIAN(Flags); - GENOP_NAME_ARITY(op, i_bs_get_float2, 6); - op->a[0] = Ms; - op->a[1] = Fail; - op->a[2] = Live; - op->a[3] = Size; - op->a[4].type = TAG_u; - op->a[4].val = (Unit.val << 3) | Flags.val; - op->a[5] = Dst; - op->next = NULL; - return op; -} - -/* - * Generate the fastest instruction for bs_skip_bits. - */ - -static GenOp* -gen_skip_bits2(LoaderState* stp, GenOpArg Fail, GenOpArg Ms, - GenOpArg Size, GenOpArg Unit, GenOpArg Flags) -{ - GenOp* op; - - NATIVE_ENDIAN(Flags); - NEW_GENOP(stp, op); - if (Size.type == TAG_a && Size.val == am_all) { - /* - * This kind of skip instruction will only be found in modules - * compiled before OTP 19. From OTP 19, the compiler generates - * a test_unit instruction of a bs_skip at the end of a - * binary. - * - * It is safe to replace the skip instruction with a test_unit - * instruction, because the position will never be used again. - * If the match context itself is used again, it will be used by - * a bs_restore2 instruction which will overwrite the position - * by one of the stored positions. - */ - GENOP_NAME_ARITY(op, bs_test_unit, 3); - op->a[0] = Fail; - op->a[1] = Ms; - op->a[2] = Unit; - } else if (Size.type == TAG_i) { - GENOP_NAME_ARITY(op, i_bs_skip_bits_imm2, 3); - op->a[0] = Fail; - op->a[1] = Ms; - op->a[2].type = TAG_u; - if (!safe_mul(Size.val, Unit.val, &op->a[2].val)) { - goto error; - } - } else if (Size.type == TAG_q) { - Eterm big = stp->literals[Size.val].term; - Uint bigval; - - if (!term_to_Uint(big, &bigval)) { - error: - GENOP_NAME_ARITY(op, jump, 1); - op->a[0] = Fail; - } else { - GENOP_NAME_ARITY(op, i_bs_skip_bits_imm2, 3); - op->a[0] = Fail; - op->a[1] = Ms; - op->a[2].type = TAG_u; - if (!safe_mul(bigval, Unit.val, &op->a[2].val)) { - goto error; - } - } - } else if (Size.type == TAG_x || Size.type == TAG_y) { - GENOP_NAME_ARITY(op, i_bs_skip_bits2, 4); - op->a[0] = Ms; - op->a[1] = Size; - op->a[2] = Fail; - op->a[3] = Unit; - } else { - /* - * Invalid literal size. Can only happen if compiler - * optimizations are selectively disabled. For example, - * at the time of writing, [no_copt, no_type_opt] will allow - * skip instructions with invalid sizes to slip through. - */ - goto error; - } - op->next = NULL; - return op; -} - -static GenOp* -gen_increment(LoaderState* stp, GenOpArg Reg, - GenOpArg Integer, GenOpArg Dst) -{ - GenOp* op; - - NEW_GENOP(stp, op); - GENOP_NAME_ARITY(op, i_increment, 3); - op->next = NULL; - op->a[0] = Reg; - op->a[1].type = TAG_u; - op->a[1].val = Integer.val; - op->a[2] = Dst; - return op; -} - -static GenOp* -gen_increment_from_minus(LoaderState* stp, GenOpArg Reg, - GenOpArg Integer, GenOpArg Dst) -{ - GenOp* op; - - NEW_GENOP(stp, op); - GENOP_NAME_ARITY(op, i_increment, 3); - op->next = NULL; - op->a[0] = Reg; - op->a[1].type = TAG_u; - op->a[1].val = -Integer.val; - op->a[2] = Dst; - return op; -} - -static GenOp* -gen_plus_from_minus(LoaderState* stp, GenOpArg Fail, GenOpArg Live, - GenOpArg Src, GenOpArg Integer, GenOpArg Dst) -{ - GenOp* op; - - NEW_GENOP(stp, op); - GENOP_NAME_ARITY(op, gen_plus, 5); - op->next = NULL; - op->a[0] = Fail; - op->a[1] = Live; - op->a[2] = Src; - op->a[3].type = TAG_i; - op->a[3].val = -Integer.val; - op->a[4] = Dst; - return op; -} - -/* - * Test whether the negation of the given number is small. - */ -static int -negation_is_small(LoaderState* stp, GenOpArg Int) -{ - /* Check for the rare case of overflow in BeamInstr (UWord) -> Sint - * Cast to the correct type before using IS_SSMALL (Sint) */ - return Int.type == TAG_i && - !(Int.val & ~((((BeamInstr)1) << ((sizeof(Sint)*8)-1))-1)) && - IS_SSMALL(-((Sint)Int.val)); -} - -/* - * Mark this label. - */ -static int -smp_mark_target_label(LoaderState* stp, GenOpArg L) -{ - ASSERT(L.type == TAG_f); - stp->labels[L.val].looprec_targeted = 1; - return 1; -} - -/* - * Test whether this label was targeted by a loop_rec/2 instruction. - */ - -static int -smp_already_locked(LoaderState* stp, GenOpArg L) -{ - ASSERT(L.type == TAG_u); - return stp->labels[L.val].looprec_targeted; -} - -/* - * Generate a timeout instruction for a literal timeout. - */ - -static GenOp* -gen_literal_timeout(LoaderState* stp, GenOpArg Fail, GenOpArg Time) -{ - GenOp* op; - Sint timeout; - - NEW_GENOP(stp, op); - GENOP_NAME_ARITY(op, wait_timeout_unlocked_int, 2); - op->next = NULL; - op->a[0].type = TAG_u; - op->a[1] = Fail; - - if (Time.type == TAG_i && (timeout = Time.val) >= 0 && -#if defined(ARCH_64) - (timeout >> 32) == 0 -#else - 1 -#endif - ) { - op->a[0].val = timeout; -#if !defined(ARCH_64) - } else if (Time.type == TAG_q) { - Eterm big; - - big = stp->literals[Time.val].term; - if (is_not_big(big)) { - goto error; - } - if (big_arity(big) > 1 || big_sign(big)) { - goto error; - } else { - Uint u; - (void) term_to_Uint(big, &u); - op->a[0].val = (BeamInstr) u; - } -#endif - } else { -#if !defined(ARCH_64) - error: -#endif - GENOP_NAME_ARITY(op, i_wait_error, 0); - } - return op; -} - -static GenOp* -gen_literal_timeout_locked(LoaderState* stp, GenOpArg Fail, GenOpArg Time) -{ - GenOp* op; - Sint timeout; - - NEW_GENOP(stp, op); - GENOP_NAME_ARITY(op, wait_timeout_locked_int, 2); - op->next = NULL; - op->a[0].type = TAG_u; - op->a[1] = Fail; - - if (Time.type == TAG_i && (timeout = Time.val) >= 0 && -#if defined(ARCH_64) - (timeout >> 32) == 0 -#else - 1 -#endif - ) { - op->a[0].val = timeout; -#if !defined(ARCH_64) - } else if (Time.type == TAG_q) { - Eterm big; - - big = stp->literals[Time.val].term; - if (is_not_big(big)) { - goto error; - } - if (big_arity(big) > 1 || big_sign(big)) { - goto error; - } else { - Uint u; - (void) term_to_Uint(big, &u); - op->a[0].val = (BeamInstr) u; - } -#endif - } else { -#if !defined(ARCH_64) - error: -#endif - GENOP_NAME_ARITY(op, i_wait_error_locked, 0); - } - return op; -} - -/* - * Tag the list of values with tuple arity tags. - */ - -static GenOp* -gen_select_tuple_arity(LoaderState* stp, GenOpArg S, GenOpArg Fail, - GenOpArg Size, GenOpArg* Rest) - -{ - GenOp* op; - GenOpArg *tmp; - int arity = Size.val + 3; - int size = Size.val / 2; - int i, j, align = 0; - - /* - * Verify the validity of the list. - */ - - if (Size.val % 2 != 0) - return NULL; - for (i = 0; i < Size.val; i += 2) { - if (Rest[i].type != TAG_u || Rest[i+1].type != TAG_f) { - return NULL; - } - } - - /* - * Use a special-cased instruction if there are only two values. - */ - if (size == 2) { - NEW_GENOP(stp, op); - GENOP_NAME_ARITY(op, i_select_tuple_arity2, 4); - GENOP_ARITY(op, arity - 1); - op->next = NULL; - op->a[0] = S; - op->a[1] = Fail; - op->a[2].type = TAG_u; - op->a[2].val = Rest[0].val; - op->a[3].type = TAG_u; - op->a[3].val = Rest[2].val; - op->a[4] = Rest[1]; - op->a[5] = Rest[3]; - - return op; - } - - /* - * Generate the generic instruction. - * Assumption: - * Few different tuple arities to select on (fewer than 20). - * Use linear scan approach. - */ - - align = 1; - - arity += 2*align; - size += align; - - NEW_GENOP(stp, op); - GENOP_NAME_ARITY(op, i_select_tuple_arity, 3); - GENOP_ARITY(op, arity); - op->next = NULL; - op->a[0] = S; - op->a[1] = Fail; - op->a[2].type = TAG_u; - op->a[2].val = size; - - tmp = (GenOpArg *) erts_alloc(ERTS_ALC_T_LOADER_TMP, sizeof(GenOpArg)*(arity-2*align)); - - for (i = 3; i < arity - 2*align; i+=2) { - tmp[i-3].type = TAG_v; - tmp[i-3].val = make_arityval(Rest[i-3].val); - tmp[i-2] = Rest[i-2]; - } - - /* - * Sort the values to make them useful for a sentinel search - */ - - qsort(tmp, size - align, 2*sizeof(GenOpArg), - (int (*)(const void *, const void *)) genopargcompare); - - j = 3; - for (i = 3; i < arity - 2*align; i += 2) { - op->a[j] = tmp[i-3]; - op->a[j + size] = tmp[i-2]; - j++; - } - - erts_free(ERTS_ALC_T_LOADER_TMP, (void *) tmp); - - op->a[j].type = TAG_u; - op->a[j].val = ~((BeamInstr)0); - op->a[j+size] = Fail; - - return op; -} - -/* - * Split a list consisting of both small and bignumbers into two - * select_val instructions. - */ - -static GenOp* -gen_split_values(LoaderState* stp, GenOpArg S, GenOpArg TypeFail, - GenOpArg Fail, GenOpArg Size, GenOpArg* Rest) - -{ - GenOp* op1; - GenOp* op2; - GenOp* label; - GenOp* is_integer; - int i; - - ASSERT(Size.val >= 2 && Size.val % 2 == 0); - - NEW_GENOP(stp, is_integer); - GENOP_NAME_ARITY(is_integer, is_integer, 2); - is_integer->a[0] = TypeFail; - is_integer->a[1] = S; - - NEW_GENOP(stp, label); - GENOP_NAME_ARITY(label, label, 1); - label->a[0].type = TAG_u; - label->a[0].val = new_label(stp); - - NEW_GENOP(stp, op1); - GENOP_NAME_ARITY(op1, select_val, 3); - GENOP_ARITY(op1, 3 + Size.val); - op1->a[0] = S; - op1->a[1].type = TAG_f; - op1->a[1].val = label->a[0].val; - op1->a[2].type = TAG_u; - op1->a[2].val = 0; - - NEW_GENOP(stp, op2); - GENOP_NAME_ARITY(op2, select_val, 3); - GENOP_ARITY(op2, 3 + Size.val); - op2->a[0] = S; - op2->a[1] = Fail; - op2->a[2].type = TAG_u; - op2->a[2].val = 0; - - /* - * Split the list. - */ - - ASSERT(Size.type == TAG_u); - for (i = 0; i < Size.val; i += 2) { - GenOp* op = (Rest[i].type == TAG_q) ? op2 : op1; - int dst = 3 + op->a[2].val; - - ASSERT(Rest[i+1].type == TAG_f); - op->a[dst] = Rest[i]; - op->a[dst+1] = Rest[i+1]; - op->arity += 2; - op->a[2].val += 2; - } - ASSERT(op1->a[2].val > 0); - ASSERT(op2->a[2].val > 0); - - /* - * Order the instruction sequence appropriately. - */ - - if (TypeFail.val == Fail.val) { - /* - * select_val L1 S ... (small numbers) - * label L1 - * is_integer Fail S - * select_val Fail S ... (bignums) - */ - op1->next = label; - label->next = is_integer; - is_integer->next = op2; - } else { - /* - * is_integer TypeFail S - * select_val L1 S ... (small numbers) - * label L1 - * select_val Fail S ... (bignums) - */ - is_integer->next = op1; - op1->next = label; - label->next = op2; - op1 = is_integer; - } - op2->next = NULL; - - return op1; -} - -/* - * Generate a jump table. - */ - -static GenOp* -gen_jump_tab(LoaderState* stp, GenOpArg S, GenOpArg Fail, GenOpArg Size, GenOpArg* Rest) -{ - Sint min, max; - Sint i; - Sint size; - Sint arity; - int fixed_args; - GenOp* op; - - ASSERT(Size.val >= 2 && Size.val % 2 == 0); - - /* - * If there is only one choice, don't generate a jump table. - */ - if (Size.val == 2) { - GenOp* jump; - - NEW_GENOP(stp, op); - GENOP_NAME_ARITY(op, is_ne_exact, 3); - op->a[0] = Rest[1]; - op->a[1] = S; - op->a[2] = Rest[0]; - - NEW_GENOP(stp, jump); - GENOP_NAME_ARITY(jump, jump, 1); - jump->a[0] = Fail; - - op->next = jump; - jump->next = NULL; - return op; - } - - /* - * Calculate the minimum and maximum values and size of jump table. - */ - - ASSERT(Rest[0].type == TAG_i); - min = max = Rest[0].val; - for (i = 2; i < Size.val; i += 2) { - ASSERT(Rest[i].type == TAG_i && Rest[i+1].type == TAG_f); - if (Rest[i].val < min) { - min = Rest[i].val; - } else if (max < Rest[i].val) { - max = Rest[i].val; - } - } - size = max - min + 1; - - /* - * Allocate structure and fill in the fixed fields. - */ - - NEW_GENOP(stp, op); - op->next = NULL; - if (min == 0) { - GENOP_NAME_ARITY(op, i_jump_on_val_zero, 3); - } else { - GENOP_NAME_ARITY(op, i_jump_on_val, 4); - } - fixed_args = op->arity; - arity = fixed_args + size; - GENOP_ARITY(op, arity); - op->a[0] = S; - op->a[1] = Fail; - op->a[2].type = TAG_u; - op->a[2].val = size; - op->a[3].type = TAG_u; - op->a[3].val = min; - - - /* - * Fill in the jump table. - */ - - for (i = fixed_args; i < arity; i++) { - op->a[i] = Fail; - } - for (i = 0; i < Size.val; i += 2) { - Sint index; - index = fixed_args+Rest[i].val-min; - ASSERT(fixed_args <= index && index < arity); - op->a[index] = Rest[i+1]; - } - return op; -} - -/* - * Compare function for qsort(). - */ - -static int -genopargcompare(GenOpArg* a, GenOpArg* b) -{ - if (a->val < b->val) - return -1; - else if (a->val == b->val) - return 0; - else - return 1; -} - -/* - * Generate a select_val instruction. We know that a jump table - * is not suitable, and that all values are of the same type - * (integer or atoms). - */ - -static GenOp* -gen_select_val(LoaderState* stp, GenOpArg S, GenOpArg Fail, - GenOpArg Size, GenOpArg* Rest) -{ - GenOp* op; - GenOpArg *tmp; - int arity = Size.val + 3; - int size = Size.val / 2; - int i, j, align = 0; - - if (size == 2) { - /* - * Use a special-cased instruction if there are only two values. - */ - - NEW_GENOP(stp, op); - op->next = NULL; - GENOP_NAME_ARITY(op, i_select_val2, 4); - GENOP_ARITY(op, arity - 1); - op->a[0] = S; - op->a[1] = Fail; - op->a[2] = Rest[0]; - op->a[3] = Rest[2]; - op->a[4] = Rest[1]; - op->a[5] = Rest[3]; - - return op; - } - - if (size <= 10) { - /* Use linear search. Reserve place for a sentinel. */ - align = 1; - } - - arity += 2*align; - size += align; - - NEW_GENOP(stp, op); - op->next = NULL; - if (align == 0) { - GENOP_NAME_ARITY(op, i_select_val_bins, 3); - } else { - GENOP_NAME_ARITY(op, i_select_val_lins, 3); - } - GENOP_ARITY(op, arity); - op->a[0] = S; - op->a[1] = Fail; - op->a[2].type = TAG_u; - op->a[2].val = size; - - tmp = (GenOpArg *) erts_alloc(ERTS_ALC_T_LOADER_TMP, sizeof(GenOpArg)*(arity-2*align)); - - for (i = 3; i < arity - 2*align; i++) { - tmp[i-3] = Rest[i-3]; - } - - /* - * Sort the values to make them useful for a binary or sentinel search. - */ - - qsort(tmp, size - align, 2*sizeof(GenOpArg), - (int (*)(const void *, const void *)) genopargcompare); - - j = 3; - for (i = 3; i < arity - 2*align; i += 2) { - op->a[j] = tmp[i-3]; - op->a[j+size] = tmp[i-2]; - j++; - } - - erts_free(ERTS_ALC_T_LOADER_TMP, (void *) tmp); - - if (align) { - /* Add sentinel for linear search. */ - op->a[j].type = TAG_u; - op->a[j].val = ~((BeamInstr)0); - op->a[j+size] = Fail; - } - -#ifdef DEBUG - for (i = 0; i < size - 1; i++) { - ASSERT(op->a[i+3].val <= op->a[i+4].val); - } -#endif - - return op; -} - -/* - * Generate a select_val instruction for big numbers. - */ - -static GenOp* -gen_select_literals(LoaderState* stp, GenOpArg S, GenOpArg Fail, - GenOpArg Size, GenOpArg* Rest) -{ - GenOp* op; - GenOp* jump; - GenOp** prev_next = &op; - - int i; - - for (i = 0; i < Size.val; i += 2) { - GenOp* op; - ASSERT(Rest[i].type == TAG_q); - - NEW_GENOP(stp, op); - GENOP_NAME_ARITY(op, is_ne_exact, 3); - op->a[0] = Rest[i+1]; - op->a[1] = S; - op->a[2] = Rest[i]; - *prev_next = op; - prev_next = &op->next; - } - - NEW_GENOP(stp, jump); - GENOP_NAME_ARITY(jump, jump, 1); - jump->next = NULL; - jump->a[0] = Fail; - *prev_next = jump; - return op; -} - - -/* - * Replace a select_val instruction with a constant controlling expression - * with a jump instruction. - */ - -static GenOp* -const_select_val(LoaderState* stp, GenOpArg S, GenOpArg Fail, - GenOpArg Size, GenOpArg* Rest) -{ - GenOp* op; - int i; - - ASSERT(Size.type == TAG_u); - - NEW_GENOP(stp, op); - GENOP_NAME_ARITY(op, jump, 1); - op->next = NULL; - - /* - * Search for a literal matching the controlling expression. - */ - - switch (S.type) { - case TAG_q: - { - Eterm expr = stp->literals[S.val].term; - for (i = 0; i < Size.val; i += 2) { - if (Rest[i].type == TAG_q) { - Eterm term = stp->literals[Rest[i].val].term; - if (eq(term, expr)) { - ASSERT(Rest[i+1].type == TAG_f); - op->a[0] = Rest[i+1]; - return op; - } - } - } - } - break; - case TAG_i: - case TAG_a: - for (i = 0; i < Size.val; i += 2) { - if (Rest[i].val == S.val && Rest[i].type == S.type) { - ASSERT(Rest[i+1].type == TAG_f); - op->a[0] = Rest[i+1]; - return op; - } - } - break; - } - - /* - * No match. Use the failure label. - */ - - op->a[0] = Fail; - return op; -} - -static GenOp* -gen_make_fun2(LoaderState* stp, GenOpArg idx) -{ - ErlFunEntry* fe; - GenOp* op; - Uint arity, num_free; - - if (idx.val >= stp->num_lambdas) { - stp->lambda_error = "missing or short chunk 'FunT'"; - fe = 0; - num_free = 0; - arity = 0; - } else { - fe = stp->lambdas[idx.val].fe; - num_free = stp->lambdas[idx.val].num_free; - arity = fe->arity; - } - - NEW_GENOP(stp, op); - - /* - * It's possible this is called before init process is started, - * skip the optimisation in such case. - */ - if (num_free == 0 && erts_init_process_id != ERTS_INVALID_PID) { - Uint lit; - Eterm* hp; - ErlFunThing* funp; - - lit = new_literal(stp, &hp, ERL_FUN_SIZE); - funp = (ErlFunThing *) hp; - erts_refc_inc(&fe->refc, 2); - funp->thing_word = HEADER_FUN; - funp->next = NULL; - funp->fe = fe; - funp->num_free = 0; - funp->creator = erts_init_process_id; - funp->arity = arity; - - /* - * Use a move_fun/2 instruction to load the fun to enable - * further optimizations. - */ - GENOP_NAME_ARITY(op, move_fun, 2); - op->a[0].type = TAG_q; - op->a[0].val = lit; - op->a[1].type = TAG_x; - op->a[1].val = 0; - } else { - GENOP_NAME_ARITY(op, i_make_fun, 2); - op->a[0].type = TAG_u; - op->a[0].val = (BeamInstr) fe; - op->a[1].type = TAG_u; - op->a[1].val = num_free; - } - - op->next = NULL; - return op; -} - -static GenOp* -gen_is_function2(LoaderState* stp, GenOpArg Fail, GenOpArg Fun, GenOpArg Arity) -{ - GenOp* op; - int literal_arity = Arity.type == TAG_i; - int fun_is_reg = Fun.type == TAG_x || Fun.type == TAG_y; - - NEW_GENOP(stp, op); - op->next = NULL; - - if (fun_is_reg &&literal_arity) { - /* - * Most common case. Fun in a register and arity - * is an integer literal. - */ - if (Arity.val > MAX_ARG) { - /* Arity is negative or too big. */ - GENOP_NAME_ARITY(op, jump, 1); - op->a[0] = Fail; - return op; - } else { - GENOP_NAME_ARITY(op, hot_is_function2, 3); - op->a[0] = Fail; - op->a[1] = Fun; - op->a[2].type = TAG_u; - op->a[2].val = Arity.val; - return op; - } - } else { - /* - * Handle extremely uncommon cases by a slower sequence. - */ - GenOp* move_fun; - GenOp* move_arity; - - NEW_GENOP(stp, move_fun); - NEW_GENOP(stp, move_arity); - - move_fun->next = move_arity; - move_arity->next = op; - - GENOP_NAME_ARITY(move_fun, move, 2); - move_fun->a[0] = Fun; - move_fun->a[1].type = TAG_x; - move_fun->a[1].val = 1022; - - GENOP_NAME_ARITY(move_arity, move, 2); - move_arity->a[0] = Arity; - move_arity->a[1].type = TAG_x; - move_arity->a[1].val = 1023; - - GENOP_NAME_ARITY(op, cold_is_function2, 3); - op->a[0] = Fail; - op->a[1].type = TAG_x; - op->a[1].val = 1022; - op->a[2].type = TAG_x; - op->a[2].val = 1023; - return move_fun; - } -} - -static GenOp* -tuple_append_put5(LoaderState* stp, GenOpArg Arity, GenOpArg Dst, - GenOpArg* Puts, GenOpArg S1, GenOpArg S2, GenOpArg S3, - GenOpArg S4, GenOpArg S5) -{ - GenOp* op; - int arity = Arity.val; /* Arity of tuple, not the instruction */ - int i; - - NEW_GENOP(stp, op); - op->next = NULL; - GENOP_NAME_ARITY(op, i_put_tuple, 2); - GENOP_ARITY(op, arity+2+5); - op->a[0] = Dst; - op->a[1].type = TAG_u; - op->a[1].val = arity + 5; - for (i = 0; i < arity; i++) { - op->a[i+2] = Puts[i]; - } - op->a[arity+2] = S1; - op->a[arity+3] = S2; - op->a[arity+4] = S3; - op->a[arity+5] = S4; - op->a[arity+6] = S5; - return op; -} - -static GenOp* -tuple_append_put(LoaderState* stp, GenOpArg Arity, GenOpArg Dst, - GenOpArg* Puts, GenOpArg S) -{ - GenOp* op; - int arity = Arity.val; /* Arity of tuple, not the instruction */ - int i; - - NEW_GENOP(stp, op); - op->next = NULL; - GENOP_NAME_ARITY(op, i_put_tuple, 2); - GENOP_ARITY(op, arity+2+1); - op->a[0] = Dst; - op->a[1].type = TAG_u; - op->a[1].val = arity + 1; - for (i = 0; i < arity; i++) { - op->a[i+2] = Puts[i]; - } - op->a[arity+2] = S; - return op; -} - -/* - * Predicate to test whether the given literal is a map. - */ - -static int -literal_is_map(LoaderState* stp, GenOpArg Lit) -{ - Eterm term; - - ASSERT(Lit.type == TAG_q); - term = stp->literals[Lit.val].term; - return is_map(term); -} - -/* - * Predicate to test whether all of the given new small map keys are literals - */ -static int -is_small_map_literal_keys(LoaderState* stp, GenOpArg Size, GenOpArg* Rest) -{ - if (Size.val > MAP_SMALL_MAP_LIMIT) { - return 0; - } - - /* - * Operations with non-literals have always only one key. - */ - if (Size.val != 2) { - return 1; - } - - switch (Rest[0].type) { - case TAG_a: - case TAG_i: - case TAG_n: - case TAG_q: - return 1; - default: - return 0; - } -} - -static GenOp* -gen_new_small_map_lit(LoaderState* stp, GenOpArg Dst, GenOpArg Live, - GenOpArg Size, GenOpArg* Rest) -{ - unsigned size = Size.val; - Uint lit; - unsigned i; - GenOp* op; - GenOpArg* dst; - Eterm* hp; - Eterm* tmp; - Eterm* thp; - Eterm keys; - - NEW_GENOP(stp, op); - GENOP_NAME_ARITY(op, i_new_small_map_lit, 3); - GENOP_ARITY(op, 3 + size/2); - op->next = NULL; - - tmp = thp = erts_alloc(ERTS_ALC_T_LOADER_TMP, (1 + size/2) * sizeof(*tmp)); - keys = make_tuple(thp); - *thp++ = make_arityval(size/2); - - dst = op->a+3; - - for (i = 0; i < size; i += 2) { - switch (Rest[i].type) { - case TAG_a: - *thp++ = Rest[i].val; - ASSERT(is_atom(Rest[i].val)); - break; - case TAG_i: - *thp++ = make_small(Rest[i].val); - break; - case TAG_n: - *thp++ = NIL; - break; - case TAG_q: - *thp++ = stp->literals[Rest[i].val].term; - break; - } - *dst++ = Rest[i + 1]; - } - - if (!find_literal(stp, keys, &lit)) { - lit = new_literal(stp, &hp, 1 + size/2); - sys_memcpy(hp, tmp, (1 + size/2) * sizeof(*tmp)); - } - erts_free(ERTS_ALC_T_LOADER_TMP, tmp); - - op->a[0] = Dst; - op->a[1] = Live; - op->a[2].type = TAG_q; - op->a[2].val = lit; - - return op; -} - -/* - * Predicate to test whether the given literal is an empty map. - */ - -static int -is_empty_map(LoaderState* stp, GenOpArg Lit) -{ - Eterm term; - - if (Lit.type != TAG_q) { - return 0; - } - term = stp->literals[Lit.val].term; - return is_flatmap(term) && flatmap_get_size(flatmap_val(term)) == 0; -} - -/* - * Pseudo predicate map_key_sort that will sort the Rest operand for - * map instructions as a side effect. - */ - -typedef struct SortGenOpArg { - Eterm term; /* Term to use for comparing */ - GenOpArg arg; /* Original data */ -} SortGenOpArg; - -static int -genopargtermcompare(SortGenOpArg* a, SortGenOpArg* b) -{ - Sint res = CMP_TERM(a->term, b->term); - - if (res < 0) { - return -1; - } else if (res > 0) { - return 1; - } - - return 0; -} - -static int -map_key_sort(LoaderState* stp, GenOpArg Size, GenOpArg* Rest) -{ - SortGenOpArg* t; - unsigned size = Size.val; - unsigned i; - - if (size == 2) { - return 1; /* Already sorted. */ - } - - - t = (SortGenOpArg *) erts_alloc(ERTS_ALC_T_TMP, size*sizeof(SortGenOpArg)); - - /* - * Copy original data and sort keys to a temporary array. - */ - for (i = 0; i < size; i += 2) { - t[i].arg = Rest[i]; - switch (Rest[i].type) { - case TAG_a: - t[i].term = Rest[i].val; - ASSERT(is_atom(t[i].term)); - break; - case TAG_i: - t[i].term = make_small(Rest[i].val); - break; - case TAG_n: - t[i].term = NIL; - break; - case TAG_q: - t[i].term = stp->literals[Rest[i].val].term; - break; - default: - /* - * Not a literal key. Not allowed. Only a single - * variable key is allowed in each map instruction. - */ - erts_free(ERTS_ALC_T_TMP, (void *) t); - return 0; - } -#ifdef DEBUG - t[i+1].term = THE_NON_VALUE; -#endif - t[i+1].arg = Rest[i+1]; - } - - /* - * Sort the temporary array. - */ - qsort((void *) t, size / 2, 2 * sizeof(SortGenOpArg), - (int (*)(const void *, const void *)) genopargtermcompare); - - /* - * Copy back the sorted, original data. - */ - for (i = 0; i < size; i++) { - Rest[i] = t[i].arg; - } - - erts_free(ERTS_ALC_T_TMP, (void *) t); - return 1; -} - -static int -hash_genop_arg(LoaderState* stp, GenOpArg Key, Uint32* hx) -{ - switch (Key.type) { - case TAG_a: - *hx = hashmap_make_hash(Key.val); - return 1; - case TAG_i: - *hx = hashmap_make_hash(make_small(Key.val)); - return 1; - case TAG_n: - *hx = hashmap_make_hash(NIL); - return 1; - case TAG_q: - *hx = hashmap_make_hash(stp->literals[Key.val].term); - return 1; - default: - return 0; - } -} - -/* - * Replace a get_map_elements with one key to an instruction with one - * element. - */ - -static GenOp* -gen_get_map_element(LoaderState* stp, GenOpArg Fail, GenOpArg Src, - GenOpArg Size, GenOpArg* Rest) -{ - GenOp* op; - GenOpArg Key; - Uint32 hx = 0; - - ASSERT(Size.type == TAG_u); - - NEW_GENOP(stp, op); - op->next = NULL; - op->a[0] = Fail; - op->a[1] = Src; - op->a[2] = Rest[0]; - - Key = Rest[0]; - if (hash_genop_arg(stp, Key, &hx)) { - GENOP_NAME_ARITY(op, i_get_map_element_hash, 5); - op->a[3].type = TAG_u; - op->a[3].val = (BeamInstr) hx; - op->a[4] = Rest[1]; - } else { - GENOP_NAME_ARITY(op, i_get_map_element, 4); - op->a[3] = Rest[1]; - } - return op; -} - -static int -hash_internal_genop_arg(LoaderState* stp, GenOpArg Key, Uint32* hx) -{ - Eterm key_term; - switch (Key.type) { - case TAG_a: - key_term = Key.val; - break; - case TAG_i: - key_term = make_small(Key.val); - break; - case TAG_n: - key_term = NIL; - break; - case TAG_q: - key_term = stp->literals[Key.val].term; - break; - default: - return 0; - } - *hx = erts_pd_make_hx(key_term); - return 1; -} - - -static GenOp* -gen_get(LoaderState* stp, GenOpArg Src, GenOpArg Dst) -{ - GenOp* op; - Uint32 hx = 0; - - NEW_GENOP(stp, op); - op->next = NULL; - if (hash_internal_genop_arg(stp, Src, &hx)) { - GENOP_NAME_ARITY(op, i_get_hash, 3); - op->a[0] = Src; - op->a[1].type = TAG_u; - op->a[1].val = (BeamInstr) hx; - op->a[2] = Dst; - } else { - GENOP_NAME_ARITY(op, i_get, 2); - op->a[0] = Src; - op->a[1] = Dst; - } - return op; -} - - -static GenOp* -gen_get_map_elements(LoaderState* stp, GenOpArg Fail, GenOpArg Src, - GenOpArg Size, GenOpArg* Rest) -{ - GenOp* op; - Uint32 hx; - Uint i; - GenOpArg* dst; -#ifdef DEBUG - int good_hash; -#endif - - ERTS_UNDEF(hx, 0); - ASSERT(Size.type == TAG_u); - - NEW_GENOP(stp, op); - GENOP_NAME_ARITY(op, i_get_map_elements, 3); - GENOP_ARITY(op, 3 + 3*(Size.val/2)); - op->next = NULL; - op->a[0] = Fail; - op->a[1] = Src; - op->a[2].type = TAG_u; - op->a[2].val = 3*(Size.val/2); - - dst = op->a+3; - for (i = 0; i < Size.val / 2; i++) { - dst[0] = Rest[2*i]; - dst[1] = Rest[2*i+1]; -#ifdef DEBUG - good_hash = -#endif - hash_genop_arg(stp, dst[0], &hx); -#ifdef DEBUG - ASSERT(good_hash); -#endif - dst[2].type = TAG_u; - dst[2].val = (BeamInstr) hx; - dst += 3; - } - return op; -} - -static GenOp* -gen_has_map_fields(LoaderState* stp, GenOpArg Fail, GenOpArg Src, - GenOpArg Size, GenOpArg* Rest) -{ - GenOp* op; - Uint i; - Uint n; - - ASSERT(Size.type == TAG_u); - n = Size.val; - - NEW_GENOP(stp, op); - GENOP_NAME_ARITY(op, get_map_elements, 3); - GENOP_ARITY(op, 3 + 2*n); - op->next = NULL; - - op->a[0] = Fail; - op->a[1] = Src; - op->a[2].type = TAG_u; - op->a[2].val = 2*n; - - for (i = 0; i < n; i++) { - op->a[3+2*i] = Rest[i]; - op->a[3+2*i+1].type = TAG_x; - op->a[3+2*i+1].val = SCRATCH_X_REG; /* Ignore result */ - } - return op; -} - -/* - * Freeze the code in memory, move the string table into place, - * resolve all labels. - */ - -static int -freeze_code(LoaderState* stp) -{ - BeamCodeHeader* code_hdr = stp->hdr; - BeamInstr* codev = (BeamInstr*) &stp->hdr->functions; - int i; - byte* str_table; - unsigned strtab_size = stp->chunks[STR_CHUNK].size; - unsigned attr_size = stp->chunks[ATTR_CHUNK].size; - unsigned compile_size = stp->chunks[COMPILE_CHUNK].size; - Uint size; - Sint decoded_size; - Uint line_size; - - /* - * Verify that there was a correct 'FunT' chunk if there were - * make_fun2 instructions in the file. - */ - - if (stp->lambda_error != NULL) { - LoadError0(stp, stp->lambda_error); - } - - /* - * Calculate the final size of the code. - */ - if (stp->line_instr == 0) { - line_size = 0; - } else { - line_size = (offsetof(BeamCodeLineTab,func_tab) - + (stp->num_functions + 1) * sizeof(BeamInstr**) /* func_tab */ - + (stp->current_li + 1) * sizeof(BeamInstr*) /* line items */ - + stp->num_fnames * sizeof(Eterm) /* fname table */ - + (stp->current_li + 1) * stp->loc_size); /* loc_tab */ - } - size = offsetof(BeamCodeHeader,functions) + (stp->ci * sizeof(BeamInstr)) + - strtab_size + attr_size + compile_size + MD5_SIZE + line_size; - - /* - * Move the code to its final location. - */ - - code_hdr = (BeamCodeHeader*) erts_realloc(ERTS_ALC_T_CODE, (void *) code_hdr, size); - codev = (BeamInstr*) &code_hdr->functions; - CHKBLK(ERTS_ALC_T_CODE,code_hdr); - /* - * Place a pointer to the op_int_code_end instruction in the - * function table in the beginning of the file. - */ - - code_hdr->functions[stp->num_functions] = (ErtsCodeInfo*)(codev + stp->ci - 1); - CHKBLK(ERTS_ALC_T_CODE,code_hdr); - - /* - * Store the pointer to the on_load function. - */ - - if (stp->on_load) { - code_hdr->on_load_function_ptr = codev + stp->on_load; - } else { - code_hdr->on_load_function_ptr = NULL; - } - CHKBLK(ERTS_ALC_T_CODE,code_hdr); - - /* - * Place the literals in their own allocated heap (for fast range check) - * and fix up all instructions that refer to it. - */ - { - Eterm* ptr; - LiteralPatch* lp; - ErlOffHeap code_off_heap; - ErtsLiteralArea *literal_area; - Uint lit_asize; - - ERTS_INIT_OFF_HEAP(&code_off_heap); - - lit_asize = ERTS_LITERAL_AREA_ALLOC_SIZE(stp->total_literal_size); - literal_area = erts_alloc(ERTS_ALC_T_LITERAL, lit_asize); - ptr = &literal_area->start[0]; - literal_area->end = ptr + stp->total_literal_size; - - for (i = 0; i < stp->num_literals; i++) { - if (is_not_immed(stp->literals[i].term)) { - erts_move_multi_frags(&ptr, &code_off_heap, - stp->literals[i].heap_frags, - &stp->literals[i].term, 1, 1); - ASSERT(erts_is_literal(stp->literals[i].term, - ptr_val(stp->literals[i].term))); - } - } - literal_area->off_heap = code_off_heap.first; - lp = stp->literal_patches; - while (lp != 0) { - BeamInstr* op_ptr; - Literal* lit; - - op_ptr = codev + lp->pos; - lit = &stp->literals[op_ptr[0]]; - op_ptr[0] = lit->term; - lp = lp->next; - } - code_hdr->literal_area = literal_area; - } - CHKBLK(ERTS_ALC_T_CODE,code); + CHKBLK(ERTS_ALC_T_CODE,code); /* * If there is line information, place it here. @@ -5315,417 +3100,6 @@ final_touch(LoaderState* stp, struct erl_module_instance* inst_p) } } -static int -transform_engine(LoaderState* st) -{ - Uint op; - int ap; /* Current argument. */ - const Uint* restart; /* Where to restart if current match fails. */ - GenOpArg var[TE_MAX_VARS]; /* Buffer for variables. */ - GenOpArg* rest_args = NULL; - int num_rest_args = 0; - int i; /* General index. */ - Uint mask; - GenOp* instr; - GenOp* first = st->genop; - GenOp* keep = NULL; - const Uint* pc; - static Uint restart_fail[1] = {TOP_fail}; - - ASSERT(gen_opc[first->op].transform != -1); - restart = op_transform + gen_opc[first->op].transform; - - restart: - ASSERT(restart != NULL); - pc = restart; - ASSERT(*pc < NUM_TOPS); /* Valid instruction? */ - instr = first; - -#ifdef DEBUG - restart = NULL; -#endif - ap = 0; - for (;;) { - op = *pc++; - - switch (op) { - case TOP_next_instr: - instr = instr->next; - ap = 0; - if (instr == NULL) { - /* - * We'll need at least one more instruction to decide whether - * this combination matches or not. - */ - return TE_SHORT_WINDOW; - } - if (*pc++ != instr->op) - goto restart; - break; - case TOP_is_type: - mask = *pc++; - - ASSERT(ap < instr->arity); - ASSERT(instr->a[ap].type < BEAM_NUM_TAGS); - if (((1 << instr->a[ap].type) & mask) == 0) - goto restart; - break; -#if defined(TOP_is_type_next_arg) - case TOP_is_type_next_arg: - mask = *pc++; - ASSERT(ap < instr->arity); - ASSERT(instr->a[ap].type < BEAM_NUM_TAGS); - if (((1 << instr->a[ap].type) & mask) == 0) - goto restart; - ap++; - break; -#endif - case TOP_pred: - i = *pc++; - switch (i) { -#define RVAL i -#include "beam_pred_funcs.h" -#undef RVAL - default: - ASSERT(0); - } - if (i == 0) - goto restart; - break; -#if defined(TOP_is_eq) - case TOP_is_eq: - ASSERT(ap < instr->arity); - if (*pc++ != instr->a[ap].val) - goto restart; - break; -#endif - case TOP_is_type_eq: - mask = *pc++; - - ASSERT(ap < instr->arity); - ASSERT(instr->a[ap].type < BEAM_NUM_TAGS); - if (((1 << instr->a[ap].type) & mask) == 0) - goto restart; - if (*pc++ != instr->a[ap].val) - goto restart; - break; -#if defined(TOP_is_type_eq_next_arg) - case TOP_is_type_eq_next_arg: - mask = *pc++; - ASSERT(ap < instr->arity); - ASSERT(instr->a[ap].type < BEAM_NUM_TAGS); - if (((1 << instr->a[ap].type) & mask) == 0) - goto restart; - if (*pc++ != instr->a[ap].val) - goto restart; - ap++; - break; -#endif - case TOP_is_same_var: - ASSERT(ap < instr->arity); - i = *pc++; - ASSERT(i < TE_MAX_VARS); - if (var[i].type != instr->a[ap].type) - goto restart; - switch (var[i].type) { - case TAG_n: - break; - default: - if (var[i].val != instr->a[ap].val) - goto restart; - } - break; -#if defined(TOP_is_bif) - case TOP_is_bif: - { - int bif_number = *pc++; - - /* - * In debug build, the type must be 'u'. - * In a real build, don't match. (I.e. retain the original - * call instruction, this will work, but it will be a - * slight performance loss.) - */ - - ASSERT(instr->a[ap].type == TAG_u); - if (instr->a[ap].type != TAG_u) - goto restart; - - /* - * In debug build, the assertion will catch invalid indexes - * immediately. In a real build, the loader will issue - * an diagnostic later when the instruction is loaded. - */ - - i = instr->a[ap].val; - ASSERT(i < st->num_imports); - if (i >= st->num_imports || st->import[i].bif == NULL) - goto restart; - if (bif_number != -1) { - Export *bif = st->import[i].bif; - if (bif->bif_number != bif_number) { - goto restart; - } - } - } - break; -#endif -#if defined(TOP_is_not_bif) - case TOP_is_not_bif: - { - pc++; - - /* - * In debug build, the type must be 'u'. - */ - - ASSERT(instr->a[ap].type == TAG_u); - if (instr->a[ap].type != TAG_u) { - goto restart; - } - i = instr->a[ap].val; - - /* - * erlang:apply/2,3 are strange. They exist as (dummy) BIFs - * so that they are included in the export table before - * the erlang module is loaded. They also exist in the erlang - * module as functions. When used in code, a special Beam - * instruction is used. - * - * Below we specially recognize erlang:apply/2,3 as special. - * This is necessary because after setting a trace pattern on - * them, you cannot no longer see from the export entry that - * they are special. - */ - if (i < st->num_imports) { - if (st->import[i].bif != NULL || - (st->import[i].module == am_erlang && - st->import[i].function == am_apply && - (st->import[i].arity == 2 || st->import[i].arity == 3))) { - goto restart; - } - } - } - break; - -#endif -#if defined(TOP_is_func) - case TOP_is_func: - { - Eterm mod = *pc++; - Eterm func = *pc++; - int arity = *pc++; - - ASSERT(instr->a[ap].type == TAG_u); - if (instr->a[ap].type != TAG_u) { - goto restart; - } - i = instr->a[ap].val; - ASSERT(i < st->num_imports); - if (i >= st->num_imports || st->import[i].module != mod || - st->import[i].function != func || - (arity < MAX_ARG && st->import[i].arity != arity)) { - goto restart; - } - } - break; -#endif - case TOP_set_var_next_arg: - ASSERT(ap < instr->arity); - i = *pc++; - ASSERT(i < TE_MAX_VARS); - var[i].type = instr->a[ap].type; - var[i].val = instr->a[ap].val; - ap++; - break; -#if defined(TOP_is_type_set_var_next_arg) - case TOP_is_type_set_var_next_arg: - mask = pc[0]; - i = pc[1]; - ASSERT(i < TE_MAX_VARS); - ASSERT(ap < instr->arity); - ASSERT(instr->a[ap].type < BEAM_NUM_TAGS); - if (((1 << instr->a[ap].type) & mask) == 0) - goto restart; - ASSERT(i < TE_MAX_VARS); - var[i] = instr->a[ap]; - ap++; - pc += 2; - break; -#endif -#if defined(TOP_is_type_eq_set_var_next_arg) - case TOP_is_type_eq_set_var_next_arg: - { - Eterm val; - mask = pc[0]; - val = pc[1]; - i = pc[2]; - ASSERT(i < TE_MAX_VARS); - ASSERT(ap < instr->arity); - ASSERT(instr->a[ap].type < BEAM_NUM_TAGS); - if (((1 << instr->a[ap].type) & mask) == 0) - goto restart; - if (val != instr->a[ap].val) - goto restart; - ASSERT(i < TE_MAX_VARS); - var[i] = instr->a[ap]; - ap++; - pc += 3; - } - break; -#endif -#if defined(TOP_rest_args) - case TOP_rest_args: - { - int formal_arity = gen_opc[instr->op].arity; - num_rest_args = instr->arity - formal_arity; - rest_args = instr->a + formal_arity; - } - break; -#endif - case TOP_next_arg: - ap++; - break; - case TOP_commit: - instr = instr->next; /* The next_instr was optimized away. */ - keep = instr; - break; -#if defined(TOP_commit_new_instr) - case TOP_commit_new_instr: - /* - * Reuse the last instruction on the left side instead of - * allocating a new instruction. Note that this is not - * safe if TOP_rest_args has been executed; therefore, - * this combined instruction is never used when that is - * the case. - */ - ASSERT(instr->a == instr->def_args); - keep = instr; - instr->op = op = *pc++; - instr->arity = gen_opc[op].arity; - ap = 0; - break; -#endif -#if defined(TOP_keep) - case TOP_keep: - /* Keep the current instruction unchanged. */ - keep = instr; - break; -#endif -#if defined(TOP_call_end) - case TOP_call_end: - { - GenOp** lastp; - GenOp* new_instr; - - i = *pc++; - switch (i) { -#define RVAL new_instr -#include "beam_tr_funcs.h" -#undef RVAL - default: - new_instr = NULL; /* Silence compiler warning. */ - ASSERT(0); - } - if (new_instr == NULL) { - goto restart; - } - - lastp = &new_instr; - while (*lastp != NULL) { - lastp = &((*lastp)->next); - } - - keep = instr->next; /* The next_instr was optimized away. */ - *lastp = keep; - instr = new_instr; - } - /* FALLTHROUGH */ -#endif - case TOP_end: - st->genop = instr; - while (first != keep) { - GenOp* next = first->next; - FREE_GENOP(st, first); - first = next; - } - return TE_OK; - case TOP_new_instr: - /* - * Note that the instructions are generated in reverse order. - */ - { - GenOp* new_instr; - NEW_GENOP(st, new_instr); - new_instr->next = instr; - instr = new_instr; - instr->op = op = *pc++; - instr->arity = gen_opc[op].arity; - ap = 0; - } - break; -#ifdef TOP_rename - case TOP_rename: - instr->op = op = *pc++; - instr->arity = gen_opc[op].arity; - return TE_OK; -#endif - case TOP_store_val_next_arg: - instr->a[ap].type = pc[0]; - instr->a[ap].val = pc[1]; - ap++; - pc += 2; - break; - case TOP_store_var_next_arg: - i = *pc++; - ASSERT(i < TE_MAX_VARS); - instr->a[ap].type = var[i].type; - instr->a[ap].val = var[i].val; - ap++; - break; -#if defined(TOP_store_rest_args) - case TOP_store_rest_args: - { - GENOP_ARITY(instr, instr->arity+num_rest_args); - sys_memcpy(instr->a, instr->def_args, ap*sizeof(GenOpArg)); - sys_memcpy(instr->a+ap, rest_args, num_rest_args*sizeof(GenOpArg)); - ap += num_rest_args; - } - break; -#endif - case TOP_try_me_else: - restart = pc + 1; - restart += *pc++; - ASSERT(*pc < NUM_TOPS); /* Valid instruction? */ - break; - case TOP_try_me_else_fail: - restart = restart_fail; - break; - case TOP_fail: - return TE_FAIL; -#if defined(TOP_skip_unless) - case TOP_skip_unless: - /* - * Note that the caller of transform_engine() guarantees that - * there is always a second instruction available. - */ - ASSERT(instr); - if (instr->next->op != pc[0]) { - /* The second instruction is wrong. Skip ahead. */ - pc += pc[1] + 2; - ASSERT(*pc < NUM_TOPS); /* Valid instruction? */ - } else { - /* Correct second instruction. */ - pc += 2; - } - break; -#endif - default: - ASSERT(0); - } - } -} - static void short_file(int line, LoaderState* stp, unsigned needed) { @@ -5871,8 +3245,8 @@ get_tag_and_value(LoaderState* stp, Uint len_code, return TAG_i; } else { tmp_big = small_to_big(val, big_buf); - if (!find_literal(stp, tmp_big, result)) { - *result = new_literal(stp, &hp, BIG_UINT_HEAP_SIZE); + if (!beam_load_find_literal(stp, tmp_big, result)) { + *result = beam_load_new_literal(stp, &hp, BIG_UINT_HEAP_SIZE); sys_memcpy(hp, big_buf, BIG_UINT_HEAP_SIZE*sizeof(Eterm)); } return TAG_q; @@ -5943,8 +3317,8 @@ get_tag_and_value(LoaderState* stp, Uint len_code, * Create a literal if there is no previous literal with the same value. */ - if (!find_literal(stp, tmp_big, result)) { - *result = new_literal(stp, &hp, words_needed); + if (!beam_load_find_literal(stp, tmp_big, result)) { + *result = beam_load_new_literal(stp, &hp, words_needed); sys_memcpy(hp, big_buf, words_needed*sizeof(Eterm)); } @@ -5981,8 +3355,8 @@ id_to_string(Uint id, char* s) *s++ = '\0'; } -static void -new_genop(LoaderState* stp) +void +beam_load_new_genop(LoaderState* stp) { GenOpBlock* p = (GenOpBlock *) erts_alloc(ERTS_ALC_T_LOADER_TMP, sizeof(GenOpBlock)); @@ -5997,8 +3371,8 @@ new_genop(LoaderState* stp) stp->free_genop = p->genop; } -static int -new_label(LoaderState* stp) +int +beam_load_new_label(LoaderState* stp) { unsigned int num = stp->num_labels; @@ -6029,8 +3403,8 @@ new_string_patch(LoaderState* stp, int pos) stp->string_patches = p; } -static Uint -new_literal(LoaderState* stp, Eterm** hpp, Uint heap_size) +Uint +beam_load_new_literal(LoaderState* stp, Eterm** hpp, Uint heap_size) { Literal* lit; @@ -6061,8 +3435,8 @@ new_literal(LoaderState* stp, Eterm** hpp, Uint heap_size) return stp->num_literals++; } -static int -find_literal(LoaderState* stp, Eterm needle, Uint *idx) +int +beam_load_find_literal(LoaderState* stp, Eterm needle, Uint *idx) { int i; @@ -6655,7 +4029,7 @@ code_module_md5_1(BIF_ALIST_1) } stp->module = THE_NON_VALUE; /* Suppress diagnostiscs */ if (!init_iff_file(stp, bytes, binary_size(Bin)) || - !scan_iff_file(stp, chunk_types, NUM_CHUNK_TYPES) || + !scan_iff_file(stp, chunk_types, ERTS_BEAM_NUM_CHUNK_TYPES) || !verify_chunks(stp)) { res = am_undefined; goto done; @@ -6995,7 +4369,7 @@ erts_make_stub_module(Process* p, Eterm hipe_magic_bin, Eterm Beam, Eterm Info) if (!init_iff_file(stp, bytes, size)) { goto error; } - if (!scan_iff_file(stp, chunk_types, NUM_CHUNK_TYPES) || + if (!scan_iff_file(stp, chunk_types, ERTS_BEAM_NUM_CHUNK_TYPES) || !verify_chunks(stp)) { goto error; } @@ -7242,18 +4616,6 @@ int erts_commit_hipe_patch_load(Eterm hipe_magic_bin) #endif /* HIPE */ -static int safe_mul(UWord a, UWord b, UWord* resp) -{ - Uint res = a * b; /* XXX:Pan - used in bit syntax, the multiplication has to be stored in Uint */ - *resp = res; - - if (b == 0) { - return 1; - } else { - return (res / b) == a; - } -} - #ifdef ENABLE_DBG_TRACE_MFA #define MFA_MAX 10 diff --git a/erts/emulator/beam/beam_load.h b/erts/emulator/beam/beam_load.h index e7127c5b08..eef2a3ad47 100644 --- a/erts/emulator/beam/beam_load.h +++ b/erts/emulator/beam/beam_load.h @@ -23,6 +23,10 @@ #include "beam_opcodes.h" #include "erl_process.h" +#include "erl_fun.h" + +#define ERTS_BEAM_MAX_OPARGS 8 +#define ERTS_BEAM_NUM_CHUNK_TYPES 11 Eterm beam_make_current_old(Process *c_p, ErtsProcLocks c_p_locks, Eterm module); @@ -37,6 +41,298 @@ typedef struct gen_op_entry { extern const GenOpEntry gen_opc[]; +/* + * Type for an operand for a generic instruction. + */ + +typedef struct { + unsigned type; /* Type of operand. */ + BeamInstr val; /* Value of operand. */ +} GenOpArg; + +/* + * A generic operation. + */ + +typedef struct genop { + unsigned int op; /* Opcode. */ + int arity; /* Number of arguments. */ + GenOpArg def_args[ERTS_BEAM_MAX_OPARGS]; /* Default buffer for arguments. */ + GenOpArg* a; /* The arguments. */ + struct genop* next; /* Next genop. */ +} GenOp; + +/* + * The allocation unit for generic blocks. + */ + +typedef struct genop_block { + GenOp genop[32]; + struct genop_block* next; +} GenOpBlock; + +/* + * Type for a reference to a label that must be patched. + */ + +typedef struct { + Uint pos; /* Position of label reference to patch. */ + Uint offset; /* Offset from patch location. */ + int packed; /* 0 (not packed), 1 (lsw), 2 (msw) */ +} LabelPatch; + +/* + * Type for a label. + */ + +typedef struct { + Uint value; /* Value of label (0 if not known yet). */ + Uint looprec_targeted; /* Non-zero if this label is the target of a loop_rec + * instruction. + */ + LabelPatch* patches; /* Array of label patches. */ + Uint num_patches; /* Number of patches in array. */ + Uint num_allocated; /* Number of allocated patches. */ +} Label; + +/* + * This structure keeps load-time information about a lambda. + */ + +typedef struct { + ErlFunEntry* fe; /* Entry in fun table. */ + unsigned label; /* Label of function entry. */ + Uint32 num_free; /* Number of free variables. */ + Eterm function; /* Name of local function. */ + int arity; /* Arity (including free variables). */ +} Lambda; + +/* + * This structure keeps load-time information about a literal. + */ + +typedef struct { + Eterm term; /* The tagged term (in the heap). */ + ErlHeapFragment* heap_frags; +} Literal; + +/* + * This structure keeps information about an operand that needs to be + * patched to contain the correct address of a literal when the code is + * frozen. + */ + +typedef struct literal_patch LiteralPatch; +struct literal_patch { + Uint pos; /* Position in code */ + LiteralPatch* next; +}; + +/* + * This structure keeps information about an operand that needs to be + * patched to contain the correct address for an address into the string table. + */ + +typedef struct string_patch StringPatch; +struct string_patch { + int pos; /* Position in code */ + StringPatch* next; +}; + +/* + * This structure associates a code offset with a source code location. + */ + +typedef struct { + int pos; /* Position in code */ + Uint32 loc; /* Location in source code */ +} LineInstr; + +/* + * This structure contains information for an imported function or BIF. + */ +typedef struct { + Eterm module; /* Tagged atom for module. */ + Eterm function; /* Tagged atom for function. */ + int arity; /* Arity. */ + Uint patches; /* Index to locations in code to + * eventually patch with a pointer into + * the export entry. + */ + Export *bif; /* Pointer to export entry if BIF; + * NULL otherwise. + */ +} ImportEntry; + +/* + * This structure contains information for a function exported from a module. + */ + +typedef struct { + Eterm function; /* Tagged atom for function. */ + int arity; /* Arity. */ + BeamInstr* address; /* Address to function in code. */ +} ExportEntry; + +/* + * This structure contains all information about the module being loaded. + */ +#define MD5_SIZE 16 +typedef struct LoaderState { + /* + * The current logical file within the binary. + */ + + char* file_name; /* Name of file we are reading (usually chunk name). */ + byte* file_p; /* Current pointer within file. */ + unsigned file_left; /* Number of bytes left in file. */ + ErlDrvBinary* bin; /* Binary holding BEAM file (or NULL) */ + + /* + * The following are used mainly for diagnostics. + */ + + Eterm group_leader; /* Group leader (for diagnostics). */ + Eterm module; /* Tagged atom for module name. */ + Eterm function; /* Tagged atom for current function + * (or 0 if none). + */ + unsigned arity; /* Arity for current function. */ + + /* + * All found chunks. + */ + + struct { + byte* start; /* Start of chunk (in binary). */ + unsigned size; /* Size of chunk. */ + } chunks[ERTS_BEAM_NUM_CHUNK_TYPES]; + + /* + * Used for code loading (mainly). + */ + + byte* code_start; /* Start of code file. */ + unsigned code_size; /* Size of code file. */ + int specific_op; /* Specific opcode (-1 if not found). */ + unsigned int num_functions; /* Number of functions in module. */ + unsigned int num_labels; /* Number of labels. */ + struct beam_code_header* hdr; /* Loaded code header */ + BeamInstr* codev; /* Loaded code buffer */ + int codev_size; /* Size of code buffer in words. */ + int ci; /* Current index into loaded code buffer. */ + Label* labels; + StringPatch* string_patches; /* Linked list of position into string table to patch. */ + BeamInstr catches; /* Linked list of catch_yf instructions. */ + unsigned loaded_size; /* Final size of code when loaded. */ + byte mod_md5[MD5_SIZE]; /* MD5 for module code. */ + int may_load_nif; /* true if NIFs may later be loaded for this module */ + int on_load; /* Index in the code for the on_load function + * (or 0 if there is no on_load function) + */ + int otp_20_or_higher; /* Compiled with OTP 20 or higher */ + unsigned max_opcode; /* Highest opcode used in module */ + + /* + * Atom table. + */ + + unsigned int num_atoms; /* Number of atoms in atom table. */ + Eterm* atom; /* Atom table. */ + + unsigned int num_exps; /* Number of exports. */ + ExportEntry* export; /* Pointer to export table. */ + + unsigned int num_imports; /* Number of imports. */ + ImportEntry* import; /* Import entry (translated information). */ + + /* + * Generic instructions. + */ + GenOp* genop; /* The last generic instruction seen. */ + GenOp* free_genop; /* List of free genops. */ + GenOpBlock* genop_blocks; /* List of all block of allocated genops. */ + + /* + * Lambda table. + */ + + unsigned int num_lambdas; /* Number of lambdas in table. */ + unsigned int lambdas_allocated; /* Size of allocated lambda table. */ + Lambda* lambdas; /* Pointer to lambdas. */ + Lambda def_lambdas[16]; /* Default storage for lambda table. */ + char* lambda_error; /* Delayed missing 'FunT' error. */ + + /* + * Literals (constant pool). + */ + + unsigned int num_literals; /* Number of literals in table. */ + unsigned int allocated_literals; /* Number of literal entries allocated. */ + Literal* literals; /* Array of literals. */ + LiteralPatch* literal_patches; /* Operands that need to be patched. */ + Uint total_literal_size; /* Total heap size for all literals. */ + + /* + * Line table. + */ + BeamInstr* line_item; /* Line items from the BEAM file. */ + unsigned int num_line_items;/* Number of line items. */ + LineInstr* line_instr; /* Line instructions */ + unsigned int num_line_instrs; /* Maximum number of line instructions */ + unsigned int current_li; /* Current line instruction */ + unsigned int* func_line; /* Mapping from function to first line instr */ + Eterm* fname; /* List of file names */ + unsigned int num_fnames; /* Number of filenames in fname table */ + int loc_size; /* Size of location info in bytes (2/4) */ +} LoaderState; + +#ifdef DEBUG +# define GARBAGE 0xCC +# define DEBUG_INIT_GENOP(Dst) sys_memset(Dst, GARBAGE, sizeof(GenOp)) +#else +# define DEBUG_INIT_GENOP(Dst) +#endif + +#define NEW_GENOP(Stp, Dst) \ + do { \ + if ((Stp)->free_genop == NULL) { \ + beam_load_new_genop((Stp)); \ + } \ + Dst = (Stp)->free_genop; \ + (Stp)->free_genop = (Stp)->free_genop->next; \ + DEBUG_INIT_GENOP(Dst); \ + (Dst)->a = (Dst)->def_args; \ + } while (0) \ + +#define FREE_GENOP(Stp, Genop) \ + do { \ + if ((Genop)->a != (Genop)->def_args) { \ + erts_free(ERTS_ALC_T_LOADER_TMP, (Genop)->a); \ + } \ + (Genop)->next = (Stp)->free_genop; \ + (Stp)->free_genop = (Genop); \ + } while (0) + +#define GENOP_NAME_ARITY(Genop, Name, Arity) \ + do { \ + (Genop)->op = genop_##Name##_##Arity; \ + (Genop)->arity = Arity; \ + } while (0) + +#define GENOP_ARITY(Genop, Arity) \ + do { \ + ASSERT((Genop)->a == (Genop)->def_args); \ + (Genop)->arity = (Arity); \ + (Genop)->a = erts_alloc(ERTS_ALC_T_LOADER_TMP, \ + (Genop)->arity * sizeof(GenOpArg)); \ + } while (0) + +void beam_load_new_genop(LoaderState* stp); +Uint beam_load_new_literal(LoaderState* stp, Eterm** hpp, Uint heap_size); +int beam_load_new_label(LoaderState* stp); +int beam_load_find_literal(LoaderState* stp, Eterm needle, Uint *idx); + struct ErtsLiteralArea_; /* @@ -106,6 +402,23 @@ typedef struct beam_code_header { }BeamCodeHeader; +/* + * The transform engine. + */ + +int erts_transform_engine(LoaderState* st); + +#define TE_OK 0 +#define TE_FAIL (-1) +#define TE_SHORT_WINDOW (-2) + +int erts_beam_eval_predicate(unsigned int op, LoaderState* st, + GenOpArg var[], GenOpArg* rest_args); +GenOp* erts_beam_execute_transform(unsigned int op, LoaderState* st, + GenOpArg var[], GenOpArg* rest_args); + + + # define BEAM_NATIVE_MIN_FUNC_SZ 4 void erts_release_literal_area(struct ErtsLiteralArea_* literal_area); diff --git a/erts/emulator/beam/beam_transform_engine.c b/erts/emulator/beam/beam_transform_engine.c new file mode 100644 index 0000000000..d8d800b538 --- /dev/null +++ b/erts/emulator/beam/beam_transform_engine.c @@ -0,0 +1,427 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2020. 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% + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include "erl_vm.h" +#include "export.h" +#include "bif.h" +#include "beam_load.h" + +int +erts_transform_engine(LoaderState* st) +{ + Uint op; + int ap; /* Current argument. */ + const Uint* restart; /* Where to restart if current match fails. */ + GenOpArg var[TE_MAX_VARS]; /* Buffer for variables. */ + GenOpArg* rest_args = NULL; + int num_rest_args = 0; + int i; /* General index. */ + Uint mask; + GenOp* instr; + GenOp* first = st->genop; + GenOp* keep = NULL; + const Uint* pc; + static Uint restart_fail[1] = {TOP_fail}; + + ASSERT(gen_opc[first->op].transform != -1); + restart = op_transform + gen_opc[first->op].transform; + + restart: + ASSERT(restart != NULL); + pc = restart; + ASSERT(*pc < NUM_TOPS); /* Valid instruction? */ + instr = first; + +#ifdef DEBUG + restart = NULL; +#endif + ap = 0; + for (;;) { + op = *pc++; + + switch (op) { + case TOP_next_instr: + instr = instr->next; + ap = 0; + if (instr == NULL) { + /* + * We'll need at least one more instruction to decide whether + * this combination matches or not. + */ + return TE_SHORT_WINDOW; + } + if (*pc++ != instr->op) + goto restart; + break; + case TOP_is_type: + mask = *pc++; + + ASSERT(ap < instr->arity); + ASSERT(instr->a[ap].type < BEAM_NUM_TAGS); + if (((1 << instr->a[ap].type) & mask) == 0) + goto restart; + break; +#if defined(TOP_is_type_next_arg) + case TOP_is_type_next_arg: + mask = *pc++; + ASSERT(ap < instr->arity); + ASSERT(instr->a[ap].type < BEAM_NUM_TAGS); + if (((1 << instr->a[ap].type) & mask) == 0) + goto restart; + ap++; + break; +#endif + case TOP_pred: + i = *pc++; + i = erts_beam_eval_predicate((unsigned) i, st, var, rest_args); + if (i == 0) + goto restart; + break; +#if defined(TOP_is_eq) + case TOP_is_eq: + ASSERT(ap < instr->arity); + if (*pc++ != instr->a[ap].val) + goto restart; + break; +#endif + case TOP_is_type_eq: + mask = *pc++; + + ASSERT(ap < instr->arity); + ASSERT(instr->a[ap].type < BEAM_NUM_TAGS); + if (((1 << instr->a[ap].type) & mask) == 0) + goto restart; + if (*pc++ != instr->a[ap].val) + goto restart; + break; +#if defined(TOP_is_type_eq_next_arg) + case TOP_is_type_eq_next_arg: + mask = *pc++; + ASSERT(ap < instr->arity); + ASSERT(instr->a[ap].type < BEAM_NUM_TAGS); + if (((1 << instr->a[ap].type) & mask) == 0) + goto restart; + if (*pc++ != instr->a[ap].val) + goto restart; + ap++; + break; +#endif + case TOP_is_same_var: + ASSERT(ap < instr->arity); + i = *pc++; + ASSERT(i < TE_MAX_VARS); + if (var[i].type != instr->a[ap].type) + goto restart; + switch (var[i].type) { + case TAG_n: + break; + default: + if (var[i].val != instr->a[ap].val) + goto restart; + } + break; +#if defined(TOP_is_bif) + case TOP_is_bif: + { + int bif_number = *pc++; + + /* + * In debug build, the type must be 'u'. + * In a real build, don't match. (I.e. retain the original + * call instruction, this will work, but it will be a + * slight performance loss.) + */ + + ASSERT(instr->a[ap].type == TAG_u); + if (instr->a[ap].type != TAG_u) + goto restart; + + /* + * In debug build, the assertion will catch invalid indexes + * immediately. In a real build, the loader will issue + * an diagnostic later when the instruction is loaded. + */ + + i = instr->a[ap].val; + ASSERT(i < st->num_imports); + if (i >= st->num_imports || st->import[i].bif == NULL) + goto restart; + if (bif_number != -1) { + Export *bif = st->import[i].bif; + if (bif->bif_number != bif_number) { + goto restart; + } + } + } + break; +#endif +#if defined(TOP_is_not_bif) + case TOP_is_not_bif: + { + pc++; + + /* + * In debug build, the type must be 'u'. + */ + + ASSERT(instr->a[ap].type == TAG_u); + if (instr->a[ap].type != TAG_u) { + goto restart; + } + i = instr->a[ap].val; + + /* + * erlang:apply/2,3 are strange. They exist as (dummy) BIFs + * so that they are included in the export table before + * the erlang module is loaded. They also exist in the erlang + * module as functions. When used in code, a special Beam + * instruction is used. + * + * Below we specially recognize erlang:apply/2,3 as special. + * This is necessary because after setting a trace pattern on + * them, you cannot no longer see from the export entry that + * they are special. + */ + if (i < st->num_imports) { + if (st->import[i].bif != NULL || + (st->import[i].module == am_erlang && + st->import[i].function == am_apply && + (st->import[i].arity == 2 || st->import[i].arity == 3))) { + goto restart; + } + } + } + break; + +#endif +#if defined(TOP_is_func) + case TOP_is_func: + { + Eterm mod = *pc++; + Eterm func = *pc++; + int arity = *pc++; + + ASSERT(instr->a[ap].type == TAG_u); + if (instr->a[ap].type != TAG_u) { + goto restart; + } + i = instr->a[ap].val; + ASSERT(i < st->num_imports); + if (i >= st->num_imports || st->import[i].module != mod || + st->import[i].function != func || + (arity < MAX_ARG && st->import[i].arity != arity)) { + goto restart; + } + } + break; +#endif + case TOP_set_var_next_arg: + ASSERT(ap < instr->arity); + i = *pc++; + ASSERT(i < TE_MAX_VARS); + var[i].type = instr->a[ap].type; + var[i].val = instr->a[ap].val; + ap++; + break; +#if defined(TOP_is_type_set_var_next_arg) + case TOP_is_type_set_var_next_arg: + mask = pc[0]; + i = pc[1]; + ASSERT(i < TE_MAX_VARS); + ASSERT(ap < instr->arity); + ASSERT(instr->a[ap].type < BEAM_NUM_TAGS); + if (((1 << instr->a[ap].type) & mask) == 0) + goto restart; + ASSERT(i < TE_MAX_VARS); + var[i] = instr->a[ap]; + ap++; + pc += 2; + break; +#endif +#if defined(TOP_is_type_eq_set_var_next_arg) + case TOP_is_type_eq_set_var_next_arg: + { + Eterm val; + mask = pc[0]; + val = pc[1]; + i = pc[2]; + ASSERT(i < TE_MAX_VARS); + ASSERT(ap < instr->arity); + ASSERT(instr->a[ap].type < BEAM_NUM_TAGS); + if (((1 << instr->a[ap].type) & mask) == 0) + goto restart; + if (val != instr->a[ap].val) + goto restart; + ASSERT(i < TE_MAX_VARS); + var[i] = instr->a[ap]; + ap++; + pc += 3; + } + break; +#endif +#if defined(TOP_rest_args) + case TOP_rest_args: + { + int formal_arity = gen_opc[instr->op].arity; + num_rest_args = instr->arity - formal_arity; + rest_args = instr->a + formal_arity; + } + break; +#endif + case TOP_next_arg: + ap++; + break; + case TOP_commit: + instr = instr->next; /* The next_instr was optimized away. */ + keep = instr; + break; +#if defined(TOP_commit_new_instr) + case TOP_commit_new_instr: + /* + * Reuse the last instruction on the left side instead of + * allocating a new instruction. Note that this is not + * safe if TOP_rest_args has been executed; therefore, + * this combined instruction is never used when that is + * the case. + */ + ASSERT(instr->a == instr->def_args); + keep = instr; + instr->op = op = *pc++; + instr->arity = gen_opc[op].arity; + ap = 0; + break; +#endif +#if defined(TOP_keep) + case TOP_keep: + /* Keep the current instruction unchanged. */ + keep = instr; + break; +#endif +#if defined(TOP_call_end) + case TOP_call_end: + { + GenOp** lastp; + GenOp* new_instr; + + i = *pc++; + new_instr = erts_beam_execute_transform((unsigned) i, st, var, rest_args); + if (new_instr == NULL) { + goto restart; + } + + lastp = &new_instr; + while (*lastp != NULL) { + lastp = &((*lastp)->next); + } + + keep = instr->next; /* The next_instr was optimized away. */ + *lastp = keep; + instr = new_instr; + } + /* FALLTHROUGH */ +#endif + case TOP_end: + st->genop = instr; + while (first != keep) { + GenOp* next = first->next; + FREE_GENOP(st, first); + first = next; + } + return TE_OK; + case TOP_new_instr: + /* + * Note that the instructions are generated in reverse order. + */ + { + GenOp* new_instr; + NEW_GENOP(st, new_instr); + new_instr->next = instr; + instr = new_instr; + instr->op = op = *pc++; + instr->arity = gen_opc[op].arity; + ap = 0; + } + break; +#ifdef TOP_rename + case TOP_rename: + instr->op = op = *pc++; + instr->arity = gen_opc[op].arity; + return TE_OK; +#endif + case TOP_store_val_next_arg: + instr->a[ap].type = pc[0]; + instr->a[ap].val = pc[1]; + ap++; + pc += 2; + break; + case TOP_store_var_next_arg: + i = *pc++; + ASSERT(i < TE_MAX_VARS); + instr->a[ap].type = var[i].type; + instr->a[ap].val = var[i].val; + ap++; + break; +#if defined(TOP_store_rest_args) + case TOP_store_rest_args: + { + GENOP_ARITY(instr, instr->arity+num_rest_args); + sys_memcpy(instr->a, instr->def_args, ap*sizeof(GenOpArg)); + sys_memcpy(instr->a+ap, rest_args, num_rest_args*sizeof(GenOpArg)); + ap += num_rest_args; + } + break; +#endif + case TOP_try_me_else: + restart = pc + 1; + restart += *pc++; + ASSERT(*pc < NUM_TOPS); /* Valid instruction? */ + break; + case TOP_try_me_else_fail: + restart = restart_fail; + break; + case TOP_fail: + return TE_FAIL; +#if defined(TOP_skip_unless) + case TOP_skip_unless: + /* + * Note that the caller of transform_engine() guarantees that + * there is always a second instruction available. + */ + ASSERT(instr); + if (instr->next->op != pc[0]) { + /* The second instruction is wrong. Skip ahead. */ + pc += pc[1] + 2; + ASSERT(*pc < NUM_TOPS); /* Valid instruction? */ + } else { + /* Correct second instruction. */ + pc += 2; + } + break; +#endif + default: + ASSERT(0); + } + } +} diff --git a/erts/emulator/beam/beam_transform_helpers.c b/erts/emulator/beam/beam_transform_helpers.c new file mode 100644 index 0000000000..546af9aee6 --- /dev/null +++ b/erts/emulator/beam/beam_transform_helpers.c @@ -0,0 +1,162 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2020. 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% + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include "beam_load.h" +#include "erl_map.h" +#include "beam_transform_helpers.h" + +typedef struct SortGenOpArg { + Eterm term; /* Term to use for comparing */ + GenOpArg arg; /* Original data */ +} SortGenOpArg; + +static int oparg_compare(GenOpArg* a, GenOpArg* b); +static int oparg_term_compare(SortGenOpArg* a, SortGenOpArg* b); + +int +beam_load_safe_mul(UWord a, UWord b, UWord* resp) +{ + Uint res = a * b; + *resp = res; + + if (b == 0) { + return 1; + } else { + return (res / b) == a; + } +} + +int +beam_load_map_key_sort(LoaderState* stp, GenOpArg Size, GenOpArg* Rest) +{ + SortGenOpArg* t; + unsigned size = Size.val; + unsigned i; + + if (size == 2) { + return 1; /* Already sorted. */ + } + + + t = (SortGenOpArg *) erts_alloc(ERTS_ALC_T_TMP, size*sizeof(SortGenOpArg)); + + /* + * Copy original data and sort keys to a temporary array. + */ + for (i = 0; i < size; i += 2) { + t[i].arg = Rest[i]; + switch (Rest[i].type) { + case TAG_a: + t[i].term = Rest[i].val; + ASSERT(is_atom(t[i].term)); + break; + case TAG_i: + t[i].term = make_small(Rest[i].val); + break; + case TAG_n: + t[i].term = NIL; + break; + case TAG_q: + t[i].term = stp->literals[Rest[i].val].term; + break; + default: + /* + * Not a literal key. Not allowed. Only a single + * variable key is allowed in each map instruction. + */ + erts_free(ERTS_ALC_T_TMP, (void *) t); + return 0; + } +#ifdef DEBUG + t[i+1].term = THE_NON_VALUE; +#endif + t[i+1].arg = Rest[i+1]; + } + + /* + * Sort the temporary array. + */ + qsort((void *) t, size / 2, 2 * sizeof(SortGenOpArg), + (int (*)(const void *, const void *)) oparg_term_compare); + + /* + * Copy back the sorted, original data. + */ + for (i = 0; i < size; i++) { + Rest[i] = t[i].arg; + } + + erts_free(ERTS_ALC_T_TMP, (void *) t); + return 1; +} + +Eterm +beam_load_get_literal(LoaderState* stp, GenOpArg Key) +{ + switch (Key.type) { + case TAG_a: + return Key.val; + case TAG_i: + return make_small(Key.val); + case TAG_n: + return NIL; + case TAG_q: + return stp->literals[Key.val].term; + default: + return THE_NON_VALUE; + } +} + +void +beam_load_sort_select_vals(GenOpArg* base, size_t n) +{ + qsort(base, n, 2 * sizeof(GenOpArg), + (int (*)(const void *, const void *)) oparg_compare); +} + +static int +oparg_compare(GenOpArg* a, GenOpArg* b) +{ + if (a->val < b->val) + return -1; + else if (a->val == b->val) + return 0; + else + return 1; +} + +static int +oparg_term_compare(SortGenOpArg* a, SortGenOpArg* b) +{ + Sint res = CMP_TERM(a->term, b->term); + + if (res < 0) { + return -1; + } else if (res > 0) { + return 1; + } + + return 0; +} diff --git a/erts/emulator/beam/beam_transform_helpers.h b/erts/emulator/beam/beam_transform_helpers.h new file mode 100644 index 0000000000..af05cb1584 --- /dev/null +++ b/erts/emulator/beam/beam_transform_helpers.h @@ -0,0 +1,28 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2020. 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% + */ + +#ifndef __BEAM_TRANSFORM_HELPERS__ +#define __BEAM_TRANSFORM_HELPERS__ + +int beam_load_safe_mul(UWord a, UWord b, UWord* resp); +int beam_load_map_key_sort(LoaderState* stp, GenOpArg Size, GenOpArg* Rest); +Eterm beam_load_get_literal(LoaderState* stp, GenOpArg Key); +void beam_load_sort_select_vals(GenOpArg* base, size_t n); +#endif diff --git a/erts/emulator/beam/float_instrs.tab b/erts/emulator/beam/float_instrs.tab index 3d4db77892..0bbe451d84 100644 --- a/erts/emulator/beam/float_instrs.tab +++ b/erts/emulator/beam/float_instrs.tab @@ -76,13 +76,3 @@ i_fnegate(Src, Dst) { $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/generators.tab b/erts/emulator/beam/generators.tab new file mode 100644 index 0000000000..c3e30d6840 --- /dev/null +++ b/erts/emulator/beam/generators.tab @@ -0,0 +1,1270 @@ +// -*- c -*- +// +// %CopyrightBegin% +// +// Copyright Ericsson AB 2020. 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% +// + +NewBeamOp(stp, op) { + NEW_GENOP($stp, $op); + $op->next = NULL; +} + +BeamOpNameArity(op, name, arity) { + GENOP_NAME_ARITY($op, $name, $arity); +} + +BeamOpArity(op, arity) { + GENOP_ARITY($op, $arity); +} + +NativeEndian(flags) { +#if defined(WORDS_BIGENDIAN) + if (($flags).val & BSF_NATIVE) { + ($flags).val &= ~(BSF_LITTLE|BSF_NATIVE); + } +#else + if (($flags).val & BSF_NATIVE) { + ($flags).val &= ~BSF_NATIVE; + ($flags).val |= BSF_LITTLE; + } +#endif +} + +gen.element(Fail, Index, Tuple, Dst) { + GenOp* op; + + $NewBeamOp(S, op); + + if (Index.type == TAG_i && Index.val > 0 && + Index.val <= ERTS_MAX_TUPLE_SIZE && + (Tuple.type == TAG_x || Tuple.type == TAG_y)) { + $BeamOpNameArity(op, i_fast_element, 4); + 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 { + $BeamOpNameArity(op, i_element, 4); + op->a[0] = Tuple; + op->a[1] = Fail; + op->a[2] = Index; + op->a[3] = Dst; + } + + return op; +} + +gen_bs_save_restore(reg, index, instr) { + GenOp* op; + + $NewBeamOp(S, op); + $BeamOpNameArity(op, $instr, 2); + op->a[0] = $reg; + op->a[1] = $index; + if (Index.type == TAG_u) { + op->a[1].val = $index.val+1; + } else if ($index.type == TAG_a && $index.val == am_start) { + op->a[1].type = TAG_u; + op->a[1].val = 0; + } + return op; +} + +gen.bs_save(Reg, Index) { + $gen_bs_save_restore(Reg, Index, i_bs_save2); +} + +gen.bs_restore(Reg, Index) { + $gen_bs_save_restore(Reg, Index, i_bs_restore2); +} + +// Generate the fastest instruction to fetch an integer from a binary. +gen.get_integer2(Fail, Ms, Live, Size, Unit, Flags, Dst) { + GenOp* op; + UWord bits; + + $NewBeamOp(S, op); + $NativeEndian(Flags); + if (Size.type == TAG_i) { + if (!beam_load_safe_mul(Size.val, Unit.val, &bits)) { + goto error; + } else if ((Flags.val & BSF_SIGNED) != 0) { + goto generic; + } else if (bits == 8) { + $BeamOpNameArity(op, i_bs_get_integer_8, 3); + op->a[0] = Ms; + op->a[1] = Fail; + op->a[2] = Dst; + } else if (bits == 16 && (Flags.val & BSF_LITTLE) == 0) { + $BeamOpNameArity(op, i_bs_get_integer_16, 3); + op->a[0] = Ms; + op->a[1] = Fail; + op->a[2] = Dst; +#ifdef ARCH_64 + } else if (bits == 32 && (Flags.val & BSF_LITTLE) == 0) { + $BeamOpNameArity(op, i_bs_get_integer_32, 3); + op->a[0] = Ms; + op->a[1] = Fail; + op->a[2] = Dst; +#endif + } else { + generic: + if (bits < SMALL_BITS) { + $BeamOpNameArity(op, i_bs_get_integer_small_imm, 5); + op->a[0] = Ms; + op->a[1].type = TAG_u; + op->a[1].val = bits; + op->a[2] = Fail; + op->a[3] = Flags; + op->a[4] = Dst; + } else { + $BeamOpNameArity(op, i_bs_get_integer_imm, 6); + op->a[0] = Ms; + op->a[1].type = TAG_u; + op->a[1].val = bits; + op->a[2] = Live; + op->a[3] = Fail; + op->a[4] = Flags; + op->a[5] = Dst; + } + } + } else if (Size.type == TAG_q) { + Eterm big = S->literals[Size.val].term; + Uint bigval; + + if (!term_to_Uint(big, &bigval)) { + error: + $BeamOpNameArity(op, jump, 1); + op->a[0] = Fail; + } else { + if (!beam_load_safe_mul(bigval, Unit.val, &bits)) { + goto error; + } + goto generic; + } + } else if (Size.type == TAG_x || Size.type == TAG_y) { + $BeamOpNameArity(op, i_bs_get_integer, 6); + op->a[0] = Ms; + op->a[1] = Fail; + op->a[2] = Live; + op->a[3].type = TAG_u; + op->a[3].val = (Unit.val << 3) | Flags.val; + op->a[4] = Size; + op->a[5] = Dst; + return op; + } else { + /* Invalid literal size. */ + goto error; + } + return op; +} + +// Generate the fastest instruction to fetch a binary from a binary. +gen.get_binary2(Fail, Ms, Live, Size, Unit, Flags, Dst) { + GenOp* op; + $NewBeamOp(S, op); + + $NativeEndian(Flags); + if (Size.type == TAG_a && Size.val == am_all) { + $BeamOpNameArity(op, i_bs_get_binary_all2, 5); + op->a[0] = Ms; + op->a[1] = Fail; + op->a[2] = Live; + op->a[3] = Unit; + op->a[4] = Dst; + } else if (Size.type == TAG_i) { + $BeamOpNameArity(op, i_bs_get_binary_imm2, 6); + op->a[0] = Ms; + op->a[1] = Fail; + op->a[2] = Live; + op->a[3].type = TAG_u; + if (!beam_load_safe_mul(Size.val, Unit.val, &op->a[3].val)) { + goto error; + } + op->a[4] = Flags; + op->a[5] = Dst; + } else if (Size.type == TAG_q) { + Eterm big = S->literals[Size.val].term; + Uint bigval; + + if (!term_to_Uint(big, &bigval)) { + error: + $BeamOpNameArity(op, jump, 1); + op->a[0] = Fail; + } else { + $BeamOpNameArity(op, i_bs_get_binary_imm2, 6); + op->a[0] = Ms; + op->a[1] = Fail; + op->a[2] = Live; + op->a[3].type = TAG_u; + if (!beam_load_safe_mul(bigval, Unit.val, &op->a[3].val)) { + goto error; + } + op->a[4] = Flags; + op->a[5] = Dst; + } + } else if (Size.type == TAG_x || Size.type == TAG_y) { + $BeamOpNameArity(op, i_bs_get_binary2, 6); + op->a[0] = Ms; + op->a[1] = Fail; + op->a[2] = Live; + op->a[3] = Size; + op->a[4].type = TAG_u; + op->a[4].val = (Unit.val << 3) | Flags.val; + op->a[5] = Dst; + } else { + /* Invalid literal size. */ + goto error; + } + return op; +} + +// Generate an instruction to fetch a float from a binary. +gen.get_float2(Fail, Ms, Live, Size, Unit, Flags, Dst) { + GenOp* op; + $NewBeamOp(S, op); + + $NativeEndian(Flags); + $BeamOpNameArity(op, i_bs_get_float2, 6); + op->a[0] = Ms; + op->a[1] = Fail; + op->a[2] = Live; + op->a[3] = Size; + op->a[4].type = TAG_u; + op->a[4].val = (Unit.val << 3) | Flags.val; + op->a[5] = Dst; + return op; +} + +gen.put_binary(Fail, Size, Unit, Flags, Src) { + GenOp* op; + $NewBeamOp(S, op); + + $NativeEndian(Flags); + if (Size.type == TAG_a && Size.val == am_all) { + $BeamOpNameArity(op, i_new_bs_put_binary_all, 3); + op->a[0] = Src; + op->a[1] = Fail; + op->a[2] = Unit; + } else if (Size.type == TAG_i) { + $BeamOpNameArity(op, i_new_bs_put_binary_imm, 3); + op->a[0] = Fail; + op->a[1].type = TAG_u; + if (beam_load_safe_mul(Size.val, Unit.val, &op->a[1].val)) { + op->a[2] = Src; + } else { + error: + $BeamOpNameArity(op, badarg, 1); + op->a[0] = Fail; + } + } else if (Size.type == TAG_q) { +#ifdef ARCH_64 + /* + * There is no way that this binary would fit in memory. + */ + goto error; +#else + Eterm big = S->literals[Size.val].term; + Uint bigval; + Uint size; + + if (!term_to_Uint(big, &bigval) || + !beam_load_safe_mul(bigval, Unit.val, &size)) { + goto error; + } + $BeamOpNameArity(op, i_new_bs_put_binary_imm, 3); + op->a[0] = Fail; + op->a[1].type = TAG_u; + op->a[1].val = size; + op->a[2] = Src; +#endif + } else { + $BeamOpNameArity(op, i_new_bs_put_binary, 4); + op->a[0] = Fail; + op->a[1] = Size; + op->a[2].type = TAG_u; + op->a[2].val = (Unit.val << 3) | (Flags.val & 7); + op->a[3] = Src; + } + + return op; +} + +gen.put_integer(Fail, Size, Unit, Flags, Src) { + GenOp* op; + $NewBeamOp(S, op); + + $NativeEndian(Flags); + /* Negative size must fail */ + if (Size.type == TAG_i) { + Uint size; + if (!beam_load_safe_mul(Size.val, Unit.val, &size)) { + error: + $BeamOpNameArity(op, badarg, 1); + op->a[0] = Fail; + return op; + } + $BeamOpNameArity(op, i_new_bs_put_integer_imm, 4); + op->a[0] = Src; + op->a[1] = Fail; + op->a[2].type = TAG_u; + op->a[2].val = size; + op->a[3].type = Flags.type; + op->a[3].val = (Flags.val & 7); + } else if (Size.type == TAG_q) { + Eterm big = S->literals[Size.val].term; + Uint bigval; + Uint size; + + if (!term_to_Uint(big, &bigval) || + !beam_load_safe_mul(bigval, Unit.val, &size)) { + goto error; + } + $BeamOpNameArity(op, i_new_bs_put_integer_imm, 4); + op->a[0] = Src; + op->a[1] = Fail; + op->a[2].type = TAG_u; + op->a[2].val = size; + op->a[3].type = Flags.type; + op->a[3].val = (Flags.val & 7); + } else { + $BeamOpNameArity(op, i_new_bs_put_integer, 4); + op->a[0] = Fail; + op->a[1] = Size; + op->a[2].type = TAG_u; + op->a[2].val = (Unit.val << 3) | (Flags.val & 7); + op->a[3] = Src; + } + return op; +} + +gen.put_float(Fail, Size, Unit, Flags, Src) { + GenOp* op; + $NewBeamOp(S, op); + + $NativeEndian(Flags); + if (Size.type == TAG_i) { + $BeamOpNameArity(op, i_new_bs_put_float_imm, 4); + op->a[0] = Fail; + op->a[1].type = TAG_u; + if (!beam_load_safe_mul(Size.val, Unit.val, &op->a[1].val)) { + $BeamOpNameArity(op, badarg, 1); + op->a[0] = Fail; + } else { + op->a[2] = Flags; + op->a[3] = Src; + } + } else { + $BeamOpNameArity(op, i_new_bs_put_float, 4); + op->a[0] = Fail; + op->a[1] = Size; + op->a[2].type = TAG_u; + op->a[2].val = (Unit.val << 3) | (Flags.val & 7); + op->a[3] = Src; + } + return op; +} + +// Generate the fastest instruction for bs_skip_bits. +gen.skip_bits2(Fail, Ms, Size, Unit, Flags) { + GenOp* op; + $NewBeamOp(S, op); + + $NativeEndian(Flags); + if (Size.type == TAG_a && Size.val == am_all) { + /* + * This kind of skip instruction will only be found in modules + * compiled before OTP 19. From OTP 19, the compiler generates + * a test_unit instruction of a bs_skip at the end of a + * binary. + * + * It is safe to replace the skip instruction with a test_unit + * instruction, because the position will never be used again. + * If the match context itself is used again, it will be used by + * a bs_restore2 instruction which will overwrite the position + * by one of the stored positions. + */ + $BeamOpNameArity(op, bs_test_unit, 3); + op->a[0] = Fail; + op->a[1] = Ms; + op->a[2] = Unit; + } else if (Size.type == TAG_i) { + $BeamOpNameArity(op, i_bs_skip_bits_imm2, 3); + op->a[0] = Fail; + op->a[1] = Ms; + op->a[2].type = TAG_u; + if (!beam_load_safe_mul(Size.val, Unit.val, &op->a[2].val)) { + goto error; + } + } else if (Size.type == TAG_q) { + Eterm big = S->literals[Size.val].term; + Uint bigval; + + if (!term_to_Uint(big, &bigval)) { + error: + $BeamOpNameArity(op, jump, 1); + op->a[0] = Fail; + } else { + $BeamOpNameArity(op, i_bs_skip_bits_imm2, 3); + op->a[0] = Fail; + op->a[1] = Ms; + op->a[2].type = TAG_u; + if (!beam_load_safe_mul(bigval, Unit.val, &op->a[2].val)) { + goto error; + } + } + } else if (Size.type == TAG_x || Size.type == TAG_y) { + $BeamOpNameArity(op, i_bs_skip_bits2, 4); + op->a[0] = Ms; + op->a[1] = Size; + op->a[2] = Fail; + op->a[3] = Unit; + } else { + /* + * Invalid literal size. Can only happen if compiler + * optimizations are selectively disabled. For example, + * at the time of writing, [no_copt, no_type_opt] will allow + * skip instructions with invalid sizes to slip through. + */ + goto error; + } + return op; +} + +gen_increment(stp, reg, val, dst) { + GenOp* op; + $NewBeamOp($stp, op); + $BeamOpNameArity(op, i_increment, 3); + op->a[0] = $reg; + op->a[1].type = TAG_u; + op->a[1].val = $val; + op->a[2] = $dst; + return op; +} + +gen.increment(Reg, Integer, Dst) { + $gen_increment(S, Reg, Integer.val, Dst); +} + +gen.increment_from_minus(Reg, Integer, Dst) { + $gen_increment(S, Reg, -Integer.val, Dst); +} + +gen.plus_from_minus(Fail, Live, Src, Integer, Dst) { + GenOp* op; + + $NewBeamOp(S, op); + $BeamOpNameArity(op, gen_plus, 5); + op->a[0] = Fail; + op->a[1] = Live; + op->a[2] = Src; + op->a[3].type = TAG_i; + op->a[3].val = -Integer.val; + op->a[4] = Dst; + return op; +} + +// Macro for generating a timeout instruction for a literal timeout value. +gen_literal_timeout(stp, fail, time, succ_instr, fail_instr) { + GenOp* op; + Sint timeout; + + $NewBeamOp($stp, op); + $BeamOpNameArity(op, $succ_instr, 2); + op->a[0].type = TAG_u; + op->a[1] = $fail; + + if ($time.type == TAG_i && (timeout = $time.val) >= 0 && +#if defined(ARCH_64) + (timeout >> 32) == 0 +#else + 1 +#endif + ) { + op->a[0].val = timeout; +#if !defined(ARCH_64) + } else if ($time.type == TAG_q) { + Eterm big; + + big = $stp->literals[$time.val].term; + if (is_not_big(big)) { + goto error; + } + if (big_arity(big) > 1 || big_sign(big)) { + goto error; + } else { + Uint u; + (void) term_to_Uint(big, &u); + op->a[0].val = (BeamInstr) u; + } +#endif + } else { +#if !defined(ARCH_64) + error: +#endif + $BeamOpNameArity(op, $fail_instr, 0); + } + return op; +} + +gen.literal_timeout(Fail, Time) { + $gen_literal_timeout(S, Fail, Time, wait_timeout_unlocked_int, i_wait_error); +} + +gen.literal_timeout_locked(Fail, Time) { + $gen_literal_timeout(S, Fail, Time, wait_timeout_locked_int, i_wait_error_locked); +} + +// Tag the list of values with tuple arity tags. +gen.select_tuple_arity(Src, Fail, Size, Rest) { + GenOp* op; + GenOpArg *tmp; + int arity = Size.val + 3; + int size = Size.val / 2; + int i, j, align = 0; + + /* + * Verify the validity of the list. + */ + + if (Size.val % 2 != 0) { + return NULL; + } + for (i = 0; i < Size.val; i += 2) { + if (Rest[i].type != TAG_u || Rest[i+1].type != TAG_f) { + return NULL; + } + } + + /* + * Use a special-cased instruction if there are only two values. + */ + if (size == 2) { + $NewBeamOp(S, op); + $BeamOpNameArity(op, i_select_tuple_arity2, 4); + $BeamOpArity(op, arity - 1); + op->a[0] = Src; + op->a[1] = Fail; + op->a[2].type = TAG_u; + op->a[2].val = Rest[0].val; + op->a[3].type = TAG_u; + op->a[3].val = Rest[2].val; + op->a[4] = Rest[1]; + op->a[5] = Rest[3]; + + return op; + } + + /* + * Generate the generic instruction. + * Assumption: + * Few different tuple arities to select on (fewer than 20). + * Use linear scan approach. + */ + + align = 1; + + arity += 2*align; + size += align; + + $NewBeamOp(S, op); + $BeamOpNameArity(op, i_select_tuple_arity, 3); + $BeamOpArity(op, arity); + op->a[0] = Src; + op->a[1] = Fail; + op->a[2].type = TAG_u; + op->a[2].val = size; + + tmp = (GenOpArg *) erts_alloc(ERTS_ALC_T_LOADER_TMP, sizeof(GenOpArg)*(arity-2*align)); + + for (i = 3; i < arity - 2*align; i+=2) { + tmp[i-3].type = TAG_v; + tmp[i-3].val = make_arityval(Rest[i-3].val); + tmp[i-2] = Rest[i-2]; + } + + /* + * Sort the values to make them useful for a sentinel search. + */ + + beam_load_sort_select_vals(tmp, size - align); + + j = 3; + for (i = 3; i < arity - 2*align; i += 2) { + op->a[j] = tmp[i-3]; + op->a[j + size] = tmp[i-2]; + j++; + } + + erts_free(ERTS_ALC_T_LOADER_TMP, (void *) tmp); + + op->a[j].type = TAG_u; + op->a[j].val = ~((BeamInstr)0); + op->a[j+size] = Fail; + + return op; +} + +// Split a list consisting of both small and bignums into two +// select_val instructions. +gen.split_values(Src, TypeFail, Fail, Size, Rest) { + GenOp* op1; + GenOp* op2; + GenOp* label; + GenOp* is_integer; + int i; + + ASSERT(Size.val >= 2 && Size.val % 2 == 0); + + $NewBeamOp(S, is_integer); + $BeamOpNameArity(is_integer, is_integer, 2); + is_integer->a[0] = TypeFail; + is_integer->a[1] = Src; + + $NewBeamOp(S, label); + $BeamOpNameArity(label, label, 1); + label->a[0].type = TAG_u; + label->a[0].val = beam_load_new_label(S); + + $NewBeamOp(S, op1); + $BeamOpNameArity(op1, select_val, 3); + $BeamOpArity(op1, 3 + Size.val); + op1->a[0] = Src; + op1->a[1].type = TAG_f; + op1->a[1].val = label->a[0].val; + op1->a[2].type = TAG_u; + op1->a[2].val = 0; + + $NewBeamOp(S, op2); + $BeamOpNameArity(op2, select_val, 3); + $BeamOpArity(op2, 3 + Size.val); + op2->a[0] = Src; + op2->a[1] = Fail; + op2->a[2].type = TAG_u; + op2->a[2].val = 0; + + /* + * Split the list. + */ + + ASSERT(Size.type == TAG_u); + for (i = 0; i < Size.val; i += 2) { + GenOp* op = (Rest[i].type == TAG_q) ? op2 : op1; + int dst = 3 + op->a[2].val; + + ASSERT(Rest[i+1].type == TAG_f); + op->a[dst] = Rest[i]; + op->a[dst+1] = Rest[i+1]; + op->arity += 2; + op->a[2].val += 2; + } + ASSERT(op1->a[2].val > 0); + ASSERT(op2->a[2].val > 0); + + /* + * Order the instruction sequence appropriately. + */ + + if (TypeFail.val == Fail.val) { + /* + * select_val L1 S ... (small numbers) + * label L1 + * is_integer Fail S + * select_val Fail S ... (bignums) + */ + op1->next = label; + label->next = is_integer; + is_integer->next = op2; + } else { + /* + * is_integer TypeFail S + * select_val L1 S ... (small numbers) + * label L1 + * select_val Fail S ... (bignums) + */ + is_integer->next = op1; + op1->next = label; + label->next = op2; + op1 = is_integer; + } + + return op1; +} + +// Generate a jump table. +gen.jump_tab(Src, Fail, Size, Rest) { + Sint min, max; + Sint i; + Sint size; + Sint arity; + int fixed_args; + GenOp* op; + + ASSERT(Size.val >= 2 && Size.val % 2 == 0); + + /* + * If there is only one choice, don't generate a jump table. + */ + if (Size.val == 2) { + GenOp* jump; + + $NewBeamOp(S, op); + $BeamOpNameArity(op, is_ne_exact, 3); + op->a[0] = Rest[1]; + op->a[1] = Src; + op->a[2] = Rest[0]; + + $NewBeamOp(S, jump); + $BeamOpNameArity(jump, jump, 1); + jump->a[0] = Fail; + + op->next = jump; + return op; + } + + /* + * Calculate the minimum and maximum values and size of jump table. + */ + + ASSERT(Rest[0].type == TAG_i); + min = max = Rest[0].val; + for (i = 2; i < Size.val; i += 2) { + ASSERT(Rest[i].type == TAG_i && Rest[i+1].type == TAG_f); + if (Rest[i].val < min) { + min = Rest[i].val; + } else if (max < Rest[i].val) { + max = Rest[i].val; + } + } + size = max - min + 1; + + /* + * Allocate structure and fill in the fixed fields. + */ + + $NewBeamOp(S, op); + if (min == 0) { + $BeamOpNameArity(op, i_jump_on_val_zero, 3); + } else { + $BeamOpNameArity(op, i_jump_on_val, 4); + } + fixed_args = op->arity; + arity = fixed_args + size; + $BeamOpArity(op, arity); + op->a[0] = Src; + op->a[1] = Fail; + op->a[2].type = TAG_u; + op->a[2].val = size; + op->a[3].type = TAG_u; + op->a[3].val = min; + + + /* + * Fill in the jump table. + */ + + for (i = fixed_args; i < arity; i++) { + op->a[i] = Fail; + } + for (i = 0; i < Size.val; i += 2) { + Sint index; + index = fixed_args+Rest[i].val-min; + ASSERT(fixed_args <= index && index < arity); + op->a[index] = Rest[i+1]; + } + return op; +} + + +// Generate a select_val instruction. We know that a jump table is +// not suitable, and that all values are of the same type (integer or +// atoms). +gen.select_val(Src, Fail, Size, Rest) { + GenOp* op; + GenOpArg *tmp; + int arity = Size.val + 3; + int size = Size.val / 2; + int i, j, align = 0; + + if (size == 2) { + /* + * Use a special-cased instruction if there are only two values. + */ + + $NewBeamOp(S, op); + $BeamOpNameArity(op, i_select_val2, 4); + $BeamOpArity(op, arity - 1); + op->a[0] = Src; + op->a[1] = Fail; + op->a[2] = Rest[0]; + op->a[3] = Rest[2]; + op->a[4] = Rest[1]; + op->a[5] = Rest[3]; + + return op; + } + + if (size <= 10) { + /* Use linear search. Reserve place for a sentinel. */ + align = 1; + } + + arity += 2*align; + size += align; + + $NewBeamOp(S, op); + if (align == 0) { + $BeamOpNameArity(op, i_select_val_bins, 3); + } else { + $BeamOpNameArity(op, i_select_val_lins, 3); + } + $BeamOpArity(op, arity); + op->a[0] = Src; + op->a[1] = Fail; + op->a[2].type = TAG_u; + op->a[2].val = size; + + tmp = (GenOpArg *) erts_alloc(ERTS_ALC_T_LOADER_TMP, sizeof(GenOpArg)*(arity-2*align)); + + for (i = 3; i < arity - 2*align; i++) { + tmp[i-3] = Rest[i-3]; + } + + /* + * Sort the values to make them useful for a binary or sentinel search. + */ + + beam_load_sort_select_vals(tmp, size - align); + + j = 3; + for (i = 3; i < arity - 2*align; i += 2) { + op->a[j] = tmp[i-3]; + op->a[j+size] = tmp[i-2]; + j++; + } + + erts_free(ERTS_ALC_T_LOADER_TMP, (void *) tmp); + + if (align) { + /* Add sentinel for linear search. */ + op->a[j].type = TAG_u; + op->a[j].val = ~((BeamInstr)0); + op->a[j+size] = Fail; + } + +#ifdef DEBUG + for (i = 0; i < size - 1; i++) { + ASSERT(op->a[i+3].val <= op->a[i+4].val); + } +#endif + + return op; +} + +// Generate a select_val instruction for big numbers. +gen.select_literals(Src, Fail, Size, Rest) { + GenOp* op; + GenOp* jump; + GenOp** prev_next = &op; + + int i; + + for (i = 0; i < Size.val; i += 2) { + GenOp* op; + ASSERT(Rest[i].type == TAG_q); + + $NewBeamOp(S, op); + $BeamOpNameArity(op, is_ne_exact, 3); + op->a[0] = Rest[i+1]; + op->a[1] = Src; + op->a[2] = Rest[i]; + *prev_next = op; + prev_next = &op->next; + } + + $NewBeamOp(S, jump); + $BeamOpNameArity(jump, jump, 1); + jump->a[0] = Fail; + *prev_next = jump; + return op; +} + + + +// Replace a select_val instruction with a constant controlling +// expression with a jump instruction. +gen.const_select_val(Src, Fail, Size, Rest) { + GenOp* op; + int i; + + ASSERT(Size.type == TAG_u); + + $NewBeamOp(S, op); + $BeamOpNameArity(op, jump, 1); + + /* + * Search for a literal matching the controlling expression. + */ + + switch (Src.type) { + case TAG_q: + { + Eterm expr = S->literals[Src.val].term; + for (i = 0; i < Size.val; i += 2) { + if (Rest[i].type == TAG_q) { + Eterm term = S->literals[Rest[i].val].term; + if (eq(term, expr)) { + ASSERT(Rest[i+1].type == TAG_f); + op->a[0] = Rest[i+1]; + return op; + } + } + } + } + break; + case TAG_i: + case TAG_a: + for (i = 0; i < Size.val; i += 2) { + if (Rest[i].val == Src.val && Rest[i].type == Src.type) { + ASSERT(Rest[i+1].type == TAG_f); + op->a[0] = Rest[i+1]; + return op; + } + } + break; + } + + /* + * No match. Use the failure label. + */ + + op->a[0] = Fail; + return op; +} + +gen.make_fun2(idx) { + ErlFunEntry* fe; + GenOp* op; + Uint arity, num_free; + + if (idx.val >= S->num_lambdas) { + S->lambda_error = "missing or short chunk 'FunT'"; + fe = 0; + num_free = 0; + arity = 0; + } else { + fe = S->lambdas[idx.val].fe; + num_free = S->lambdas[idx.val].num_free; + arity = fe->arity; + } + + $NewBeamOp(S, op); + + /* + * It's possible this is called before init process is started, + * skip the optimisation in such case. + */ + if (num_free == 0 && erts_init_process_id != ERTS_INVALID_PID) { + Uint lit; + Eterm* hp; + ErlFunThing* funp; + + lit = beam_load_new_literal(S, &hp, ERL_FUN_SIZE); + funp = (ErlFunThing *) hp; + erts_refc_inc(&fe->refc, 2); + funp->thing_word = HEADER_FUN; + funp->next = NULL; + funp->fe = fe; + funp->num_free = 0; + funp->creator = erts_init_process_id; + funp->arity = arity; + + /* + * Use a move_fun/2 instruction to load the fun to enable + * further optimizations. + */ + $BeamOpNameArity(op, move_fun, 2); + op->a[0].type = TAG_q; + op->a[0].val = lit; + op->a[1].type = TAG_x; + op->a[1].val = 0; + } else { + $BeamOpNameArity(op, i_make_fun, 2); + op->a[0].type = TAG_u; + op->a[0].val = (BeamInstr) fe; + op->a[1].type = TAG_u; + op->a[1].val = num_free; + } + + return op; +} + +gen.is_function2(Fail, Fun, Arity) { + GenOp* op; + int literal_arity = Arity.type == TAG_i; + int fun_is_reg = Fun.type == TAG_x || Fun.type == TAG_y; + + $NewBeamOp(S, op); + + if (fun_is_reg &&literal_arity) { + /* + * Most common case. Fun in a register and arity + * is an integer literal. + */ + if (Arity.val > MAX_ARG) { + /* Arity is negative or too big. */ + $BeamOpNameArity(op, jump, 1); + op->a[0] = Fail; + return op; + } else { + $BeamOpNameArity(op, hot_is_function2, 3); + op->a[0] = Fail; + op->a[1] = Fun; + op->a[2].type = TAG_u; + op->a[2].val = Arity.val; + return op; + } + } else { + /* + * Handle extremely uncommon cases by a slower sequence. + */ + GenOp* move_fun; + GenOp* move_arity; + + $NewBeamOp(S, move_fun); + $NewBeamOp(S, move_arity); + + move_fun->next = move_arity; + move_arity->next = op; + + $BeamOpNameArity(move_fun, move, 2); + move_fun->a[0] = Fun; + move_fun->a[1].type = TAG_x; + move_fun->a[1].val = 1022; + + $BeamOpNameArity(move_arity, move, 2); + move_arity->a[0] = Arity; + move_arity->a[1].type = TAG_x; + move_arity->a[1].val = 1023; + + $BeamOpNameArity(op, cold_is_function2, 3); + op->a[0] = Fail; + op->a[1].type = TAG_x; + op->a[1].val = 1022; + op->a[2].type = TAG_x; + op->a[2].val = 1023; + return move_fun; + } +} + +gen.tuple_append_put5(Arity, Dst, Puts, S1, S2, S3, S4, S5) { + GenOp* op; + int arity = Arity.val; /* Arity of tuple, not the instruction */ + int i; + + $NewBeamOp(S, op); + $BeamOpNameArity(op, i_put_tuple, 2); + $BeamOpArity(op, arity+2+5); + op->a[0] = Dst; + op->a[1].type = TAG_u; + op->a[1].val = arity + 5; + for (i = 0; i < arity; i++) { + op->a[i+2] = Puts[i]; + } + op->a[arity+2] = S1; + op->a[arity+3] = S2; + op->a[arity+4] = S3; + op->a[arity+5] = S4; + op->a[arity+6] = S5; + return op; +} + +gen.tuple_append_put(Arity, Dst, Puts, Src) { + GenOp* op; + int arity = Arity.val; /* Arity of tuple, not the instruction */ + int i; + + $NewBeamOp(S, op); + $BeamOpNameArity(op, i_put_tuple, 2); + $BeamOpArity(op, arity+2+1); + op->a[0] = Dst; + op->a[1].type = TAG_u; + op->a[1].val = arity + 1; + for (i = 0; i < arity; i++) { + op->a[i+2] = Puts[i]; + } + op->a[arity+2] = Src; + return op; +} + +// Generate an instruction for get/1. +gen.get(Src, Dst) { + GenOp* op; + Eterm key_term; + + $NewBeamOp(S, op); + key_term = beam_load_get_literal(S, Src); + if (is_value(key_term)) { + $BeamOpNameArity(op, i_get_hash, 3); + op->a[0] = Src; + op->a[1].type = TAG_u; + op->a[1].val = (BeamInstr) erts_pd_make_hx(key_term); + op->a[2] = Dst; + } else { + $BeamOpNameArity(op, i_get, 2); + op->a[0] = Src; + op->a[1] = Dst; + } + return op; +} + +gen.new_small_map_lit(Dst, Live, Size, Rest) { + unsigned size = Size.val; + Uint lit; + unsigned i; + GenOp* op; + GenOpArg* dst; + Eterm* hp; + Eterm* tmp; + Eterm* thp; + Eterm keys; + + $NewBeamOp(S, op); + $BeamOpNameArity(op, i_new_small_map_lit, 3); + $BeamOpArity(op, 3 + size/2); + + tmp = thp = erts_alloc(ERTS_ALC_T_LOADER_TMP, (1 + size/2) * sizeof(*tmp)); + keys = make_tuple(thp); + *thp++ = make_arityval(size/2); + + dst = op->a+3; + + for (i = 0; i < size; i += 2) { + switch (Rest[i].type) { + case TAG_a: + *thp++ = Rest[i].val; + ASSERT(is_atom(Rest[i].val)); + break; + case TAG_i: + *thp++ = make_small(Rest[i].val); + break; + case TAG_n: + *thp++ = NIL; + break; + case TAG_q: + *thp++ = S->literals[Rest[i].val].term; + break; + } + *dst++ = Rest[i + 1]; + } + + if (!beam_load_find_literal(S, keys, &lit)) { + lit = beam_load_new_literal(S, &hp, 1 + size/2); + sys_memcpy(hp, tmp, (1 + size/2) * sizeof(*tmp)); + } + erts_free(ERTS_ALC_T_LOADER_TMP, tmp); + + op->a[0] = Dst; + op->a[1] = Live; + op->a[2].type = TAG_q; + op->a[2].val = lit; + + return op; +} + +// Replace a get_map_elements instruction with a single key to an +// instruction with one element. +gen.get_map_element(Fail, Src, Size, Rest) { + GenOp* op; + GenOpArg Key; + Eterm key_term; + + ASSERT(Size.type == TAG_u); + + $NewBeamOp(S, op); + op->a[0] = Fail; + op->a[1] = Src; + op->a[2] = Rest[0]; + + Key = Rest[0]; + key_term = beam_load_get_literal(S, Key); + if (is_value(key_term)) { + $BeamOpNameArity(op, i_get_map_element_hash, 5); + op->a[3].type = TAG_u; + op->a[3].val = (BeamInstr) hashmap_make_hash(key_term); + op->a[4] = Rest[1]; + } else { + $BeamOpNameArity(op, i_get_map_element, 4); + op->a[3] = Rest[1]; + } + return op; +} + +gen.get_map_elements(Fail, Src, Size, Rest) { + GenOp* op; + Uint i; + GenOpArg* dst; + Eterm key_term; + + ASSERT(Size.type == TAG_u); + + $NewBeamOp(S, op); + $BeamOpNameArity(op, i_get_map_elements, 3); + $BeamOpArity(op, 3 + 3*(Size.val/2)); + op->a[0] = Fail; + op->a[1] = Src; + op->a[2].type = TAG_u; + op->a[2].val = 3*(Size.val/2); + + dst = op->a+3; + for (i = 0; i < Size.val / 2; i++) { + dst[0] = Rest[2*i]; + dst[1] = Rest[2*i+1]; + dst[2].type = TAG_u; + key_term = beam_load_get_literal(S, dst[0]); + dst[2].val = (BeamInstr) hashmap_make_hash(key_term); + dst += 3; + } + return op; +} + +gen.has_map_fields(Fail, Src, Size, Rest) { + GenOp* op; + Uint i; + Uint n; + + ASSERT(Size.type == TAG_u); + n = Size.val; + + $NewBeamOp(S, op); + $BeamOpNameArity(op, get_map_elements, 3); + $BeamOpArity(op, 3 + 2*n); + + op->a[0] = Fail; + op->a[1] = Src; + op->a[2].type = TAG_u; + op->a[2].val = 2*n; + + for (i = 0; i < n; i++) { + op->a[3+2*i] = Rest[i]; + op->a[3+2*i+1].type = TAG_x; + op->a[3+2*i+1].val = SCRATCH_X_REG; /* Ignore result */ + } + return op; +} diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab index f3ab8bf48d..49bd7a128c 100644 --- a/erts/emulator/beam/ops.tab +++ b/erts/emulator/beam/ops.tab @@ -144,35 +144,35 @@ init3 y y y select_val S=aiq Fail=f Size=u Rest=* => const_select_val(S, Fail, Size, Rest) select_val S=s Fail=f Size=u Rest=* | use_jump_tab(Size, Rest) => \ - gen_jump_tab(S, Fail, Size, Rest) + jump_tab(S, Fail, Size, Rest) is_integer Fail=f S | select_val S=s Fail=f Size=u Rest=* | use_jump_tab(Size, Rest) => \ - gen_jump_tab(S, Fail, Size, Rest) + jump_tab(S, Fail, Size, Rest) is_integer TypeFail=f S | select_val S=s Fail=f Size=u Rest=* | \ mixed_types(Size, Rest) => \ - gen_split_values(S, TypeFail, Fail, Size, Rest) + split_values(S, TypeFail, Fail, Size, Rest) select_val S=s Fail=f Size=u Rest=* | mixed_types(Size, Rest) => \ - gen_split_values(S, Fail, Fail, Size, Rest) + split_values(S, Fail, Fail, Size, Rest) is_integer Fail=f S | select_val S=d Fail=f Size=u Rest=* | \ - fixed_size_values(Size, Rest) => gen_select_val(S, Fail, Size, Rest) + fixed_size_values(Size, Rest) => select_val(S, Fail, Size, Rest) is_atom Fail=f S | select_val S=d Fail=f Size=u Rest=* | \ - fixed_size_values(Size, Rest) => gen_select_val(S, Fail, Size, Rest) + fixed_size_values(Size, Rest) => select_val(S, Fail, Size, Rest) select_val S=s Fail=f Size=u Rest=* | floats_or_bignums(Size, Rest) => \ - gen_select_literals(S, Fail, Size, Rest) + select_literals(S, Fail, Size, Rest) select_val S=d Fail=f Size=u Rest=* | fixed_size_values(Size, Rest) => \ - gen_select_val(S, Fail, Size, Rest) + select_val(S, Fail, Size, Rest) is_tuple Fail=f S | select_tuple_arity S=d Fail=f Size=u Rest=* => \ - gen_select_tuple_arity(S, Fail, Size, Rest) + select_tuple_arity(S, Fail, Size, Rest) select_tuple_arity S=d Fail=f Size=u Rest=* => \ - gen_select_tuple_arity(S, Fail, Size, Rest) + select_tuple_arity(S, Fail, Size, Rest) i_select_val_bins xy f? I @@ -294,13 +294,13 @@ move_jump f c r move X1=x Y1=y | move X2=x Y2=y | succ(Y1, Y2) => \ move_window2 X1 X2 Y1 -move_window2 X1 X2 Y1 | move X3=x Y3=y | offset(Y1, Y3, 2) => \ +move_window2 X1 X2 Y1 | move X3=x Y3=y | is_offset(Y1, Y3, 2) => \ move_window3 X1 X2 X3 Y1 -move_window3 X1 X2 X3 Y1 | move X4=x Y4=y | offset(Y1, Y4, 3) => \ +move_window3 X1 X2 X3 Y1 | move X4=x Y4=y | is_offset(Y1, Y4, 3) => \ move_window4 X1 X2 X3 X4 Y1 -move_window4 X1 X2 X3 X4 Y1=y | move X5=x Y5=y | offset(Y1, Y5, 4) => \ +move_window4 X1 X2 X3 X4 Y1=y | move X5=x Y5=y | is_offset(Y1, Y5, 4) => \ move_window5 X1 X2 X3 X4 X5 Y1 move_window2 x x y @@ -424,8 +424,8 @@ 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 Src=aiq Fail => gen_literal_timeout(Fail, Src) -wait_timeout_locked Src=aiq Fail => gen_literal_timeout_locked(Fail, Src) +wait_timeout_unlocked Src=aiq Fail => literal_timeout(Fail, Src) +wait_timeout_locked Src=aiq Fail => literal_timeout_locked(Fail, Src) label L | wait Fail | smp_already_locked(L) => label L | wait_locked Fail wait Fail => wait_unlocked Fail @@ -787,7 +787,7 @@ is_boolean Fail=f ac => jump Fail is_boolean f? xy %hot -is_function2 Fail=f Fun Arity => gen_is_function2(Fail, Fun, Arity) +is_function2 Fail=f Fun Arity => is_function2(Fail, Fun, Arity) %cold cold_is_function2 f? x x @@ -1028,9 +1028,9 @@ bif0 u$bif:erlang:node/0 Dst=d => node Dst bif1 Fail=f Bif=u$bif:erlang:hd/1 Src=x Dst=x => is_nonempty_list_get_hd Fail Src Dst bif1 Fail=f Bif=u$bif:erlang:tl/1 Src=x Dst=x => is_nonempty_list_get_tl Fail Src Dst -bif1 Fail Bif=u$bif:erlang:get/1 Src=s Dst=d => gen_get(Src, Dst) +bif1 Fail Bif=u$bif:erlang:get/1 Src=s Dst=d => get(Src, Dst) -bif2 Jump=j u$bif:erlang:element/2 S1=s S2=xy Dst=d => gen_element(Jump, S1, S2, Dst) +bif2 Jump=j u$bif:erlang:element/2 S1=s S2=xy Dst=d => element(Jump, S1, S2, Dst) bif1 p Bif S1 Dst => i_bif1_body S1 Bif Dst bif1 Fail=f Bif S1 Dst => i_bif1 S1 Fail Bif Dst @@ -1110,7 +1110,7 @@ i_call_fun_last t Q # As a further optimization, the we try to move the fun to its # final destination directly. -make_fun2 OldIndex=u => gen_make_fun2(OldIndex) +make_fun2 OldIndex=u => make_fun2(OldIndex) move_fun/2 move_fun Fun X0 | move X0 Dst | move Src X0 => move Fun Dst | move Src X0 @@ -1142,11 +1142,11 @@ bs_start_match2 Fail Bin X Y D => i_bs_start_match2 Bin Fail X Y D i_bs_start_match2 xy f t t d bs_save2 Y=y Index => move Y x | bs_save2 x Index -bs_save2 Reg Index => gen_bs_save(Reg, Index) +bs_save2 Reg Index => bs_save(Reg, Index) i_bs_save2 x t bs_restore2 Y=y Index => move Y x | bs_restore2 x Index -bs_restore2 Reg Index => gen_bs_restore(Reg, Index) +bs_restore2 Reg Index => bs_restore(Reg, Index) i_bs_restore2 x t bs_context_to_binary Y=y | line L | badmatch Y => \ @@ -1168,7 +1168,7 @@ i_bs_match_string xy f W W # Fetching integers from binaries. bs_get_integer2 Fail=f Ms=xy Live=u Sz=sq Unit=u Flags=u Dst=d => \ - gen_get_integer2(Fail, Ms, Live, Sz, Unit, Flags, Dst) + get_integer2(Fail, Ms, Live, Sz, Unit, Flags, Dst) i_bs_get_integer_small_imm Ms Bits Fail Flags Y=y => \ i_bs_get_integer_small_imm Ms Bits Fail Flags x | move x Y @@ -1188,7 +1188,7 @@ i_bs_get_integer_32 xy f? d # Fetching binaries from binaries. bs_get_binary2 Fail=f Ms=xy Live=u Sz=sq Unit=u Flags=u Dst=d => \ - gen_get_binary2(Fail, Ms, Live, Sz, Unit, Flags, Dst) + get_binary2(Fail, Ms, Live, Sz, Unit, Flags, Dst) i_bs_get_binary_imm2 xy f? t W t d i_bs_get_binary2 xy f t? S t d @@ -1196,7 +1196,7 @@ i_bs_get_binary_all2 xy f? t t d # Fetching float from binaries. bs_get_float2 Fail=f Ms=xy Live=u Sz=s Unit=u Flags=u Dst=d => \ - gen_get_float2(Fail, Ms, Live, Sz, Unit, Flags, Dst) + get_float2(Fail, Ms, Live, Sz, Unit, Flags, Dst) bs_get_float2 Fail=f Ms=x Live=u Sz=q Unit=u Flags=u Dst=d => jump Fail @@ -1204,8 +1204,7 @@ i_bs_get_float2 xy f? t s t d # Miscellaneous -bs_skip_bits2 Fail=f Ms=xy Sz=sq Unit=u Flags=u => \ - gen_skip_bits2(Fail, Ms, Sz, Unit, Flags) +bs_skip_bits2 Fail=f Ms=xy Sz=sq Unit=u Flags=u => skip_bits2(Fail, Ms, Sz, Unit, Flags) i_bs_skip_bits_imm2 f? xy W i_bs_skip_bits2 xy xy f? t @@ -1358,7 +1357,7 @@ 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) + put_integer(Fail, Sz, Unit, Flags, Src) i_new_bs_put_integer j? S t s i_new_bs_put_integer_imm xyc j? W t @@ -1396,7 +1395,7 @@ i_bs_validate_unicode Fail Src=c => move Src x | i_bs_validate_unicode Fail x 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) + 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 @@ -1406,7 +1405,7 @@ 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) + put_binary(Fail, Sz, Unit, Flags, Src) # In unoptimized code, the binary argument could be a literal. (In optimized code, # there would be a bs_put_string instruction.) @@ -1455,15 +1454,12 @@ i_fmul l l l i_fdiv l l l 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 +# +# FPE signals were disabled in OTP 21 and we don't intend to ever +# enable them again. +# +fclearerror => +fcheckerror p => %hot @@ -1527,7 +1523,7 @@ sorted_put_map_exact Fail Src Dst Live Size Rest=* => \ move Src x | update_map_exact x Fail Dst Live Size Rest new_map Dst Live Size Rest=* | is_small_map_literal_keys(Size, Rest) => \ - gen_new_small_map_lit(Dst, Live, Size, Rest) + new_small_map_lit(Dst, Live, Size, Rest) new_map d t I i_new_small_map_lit d t q @@ -1541,15 +1537,14 @@ is_map f? xy ## Transform has_map_fields #{ K1 := _, K2 := _ } to has_map_elements -has_map_fields Fail Src Size Rest=* => \ - gen_has_map_fields(Fail, Src, Size, Rest) +has_map_fields Fail Src Size Rest=* => has_map_fields(Fail, Src, Size, Rest) ## Transform get_map_elements(s) #{ K1 := V1, K2 := V2 } get_map_elements Fail Src Size=u==2 Rest=* => \ - gen_get_map_element(Fail, Src, Size, Rest) + get_map_element(Fail, Src, Size, Rest) get_map_elements Fail Src Size Rest=* | map_key_sort(Size, Rest) => \ - gen_get_map_elements(Fail, Src, Size, Rest) + get_map_elements(Fail, Src, Size, Rest) i_get_map_elements f? s I @@ -1583,12 +1578,12 @@ gc_bif2 Fail Live u$bif:erlang:sminus/2 S1 S2 Dst => \ # gen_plus p Live Int=i Reg=d Dst => \ - gen_increment(Reg, Int, Dst) + increment(Reg, Int, Dst) gen_plus p Live Reg=d Int=i Dst => \ - gen_increment(Reg, Int, Dst) + increment(Reg, Int, Dst) gen_minus p Live Reg=d Int=i Dst | negation_is_small(Int) => \ - gen_increment_from_minus(Reg, Int, Dst) + increment_from_minus(Reg, Int, Dst) # # Arithmetic instructions. @@ -1597,7 +1592,7 @@ gen_minus p Live Reg=d Int=i Dst | negation_is_small(Int) => \ # It is OK to swap arguments for '+' in a guard. It is also # OK to turn minus into plus in a guard. gen_plus Fail=f Live S1=c S2 Dst => i_plus S2 S1 Fail Dst -gen_minus Fail=f Live S1 S2=i Dst => gen_plus_from_minus(Fail, Live, S1, S2, Dst) +gen_minus Fail=f Live S1 S2=i Dst => plus_from_minus(Fail, Live, S1, S2, Dst) gen_plus Fail Live S1 S2 Dst => i_plus S1 S2 Fail Dst diff --git a/erts/emulator/beam/predicates.tab b/erts/emulator/beam/predicates.tab new file mode 100644 index 0000000000..bbff57172b --- /dev/null +++ b/erts/emulator/beam/predicates.tab @@ -0,0 +1,269 @@ +// -*- c -*- +// +// %CopyrightBegin% +// +// Copyright Ericsson AB 2020. 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% +// + +pred.is_offset(X, Y, Offset) { + return X.type == Y.type && X.val + Offset == Y.val; +} + + +pred.succ(X, Y) { + return X.type == Y.type && X.val + 1 == Y.val; +} + +pred.succ3(X, Y) { + return X.type == Y.type && X.val + 3 == Y.val; +} + +pred.succ4(X, Y) { + return X.type == Y.type && X.val + 4 == Y.val; +} + +pred.never() { + return 0; +} + +pred.compiled_with_otp_20_or_higher() { + return S->otp_20_or_higher; +} + +// Test whether the following two moves are independent: +// +// move Src1 Dst1 +// move Src2 Dst2 +// +pred.independent_moves(Src1, Dst1, Src2, Dst2) { + return (Src1.type != Dst2.type || Src1.val != Dst2.val) && + (Src2.type != Dst1.type || Src2.val != Dst1.val) && + (Dst1.type != Dst2.type ||Dst1.val != Dst2.val); +} + + +// Test that the two registers are distinct. +pred.distinct(Reg1, Reg2) { + return Reg1.type != Reg2.type || Reg1.val != Reg2.val; +} + +// Test whether a jump table can be used. +pred.use_jump_tab(Size, Rest) { + Sint min, max; + Sint i; + + if (Size.val < 2 || Size.val % 2 != 0) { + return 0; + } + + if (Rest[0].type != TAG_i || Rest[1].type != TAG_f) { + /* Atoms. Can't use a jump table. */ + return 0; + } + + min = max = Rest[0].val; + for (i = 2; i < Size.val; i += 2) { + if (Rest[i].type != TAG_i || Rest[i+1].type != TAG_f) { + return 0; + } + if (Rest[i].val < min) { + min = Rest[i].val; + } else if (max < Rest[i].val) { + max = Rest[i].val; + } + } + + return max - min <= Size.val; +} + +// Test whether all values in a table are either floats or bignums. +pred.floats_or_bignums(Size, Rest) { + int i; + + if (Size.val < 2 || Size.val % 2 != 0) { + return 0; + } + + for (i = 0; i < Size.val; i += 2) { + if (Rest[i].type != TAG_q) { + return 0; + } + if (Rest[i+1].type != TAG_f) { + return 0; + } + } + + return 1; +} + + +// Test whether all values in a table have a fixed size. +pred.fixed_size_values(Size, Rest) { + int i; + + if (Size.val < 2 || Size.val % 2 != 0) { + return 0; + } + + for (i = 0; i < Size.val; i += 2) { + if (Rest[i+1].type != TAG_f) { + return 0; + } + switch (Rest[i].type) { + case TAG_a: + case TAG_i: + case TAG_v: + break; + case TAG_q: + return is_float(S->literals[Rest[i].val].term); + default: + return 0; + } + } + + return 1; +} + +// Test whether a table has mixe types. +pred.mixed_types(Size, Rest) { + int i; + Uint type; + + if (Size.val < 2 || Size.val % 2 != 0) { + return 0; + } + + type = Rest[0].type; + for (i = 0; i < Size.val; i += 2) { + if (Rest[i].type != type) { + return 1; + } + } + + return 0; +} + +// Test whether register Reg is killed by a make_fun instruction that +// creates the fun given by index idx. +pred.is_killed_by_make_fun(Reg, idx) { + Uint num_free; + + if (idx.val >= S->num_lambdas) { + /* Invalid index. Ignore the error for now. */ + return 0; + } else { + num_free = S->lambdas[idx.val].num_free; + return Reg.type == TAG_x && num_free <= Reg.val; + } +} + +// Test whether Bif is "heavy" and should always go through its export entry. +pred.is_heavy_bif(Bif) { + Export *ep; + + if (Bif.type != TAG_u || Bif.val >= S->num_imports) { + return 0; + } + + if ((ep = S->import[Bif.val].bif) != 0) { + return bif_table[ep->bif_number].kind == BIF_KIND_HEAVY; + } + + return 0; +} + +// Test whether the given literal is a map. +pred.literal_is_map(Lit) { + Eterm term; + + ASSERT(Lit.type == TAG_q); + term = S->literals[Lit.val].term; + return is_map(term); +} + +// Predicate to test whether all of the given new small map keys are literals +pred.is_small_map_literal_keys(Size, Rest) { + if (Size.val > MAP_SMALL_MAP_LIMIT) { + return 0; + } + + /* + * Operations with non-literals have always only one key. + */ + if (Size.val != 2) { + return 1; + } + + switch (Rest[0].type) { + case TAG_a: + case TAG_i: + case TAG_n: + case TAG_q: + return 1; + default: + return 0; + } +} + +// Test whether the given literal is an empty map. +pred.is_empty_map(Lit) { + Eterm term; + + if (Lit.type != TAG_q) { + return 0; + } + term = S->literals[Lit.val].term; + return is_flatmap(term) && flatmap_get_size(flatmap_val(term)) == 0; +} + +// Test whether a binary construction is too big. +pred.binary_too_big(Size) { + return Size.type == TAG_o || + (Size.type == TAG_u && ((Size.val >> (8*sizeof(Uint)-3)) != 0)); +} + + +// Test whether the negation of the given number is small. +pred.negation_is_small(Int) { + /* + * Check for the rare case of overflow in BeamInstr (UWord) -> Sint. + * Cast to the correct type before using IS_SSMALL (Sint). + */ + return Int.type == TAG_i && + !(Int.val & ~((((BeamInstr)1) << ((sizeof(Sint)*8)-1))-1)) && + IS_SSMALL(-((Sint)Int.val)); +} + +// Mark this label. Always succeeds. +pred.smp_mark_target_label(L) { + ASSERT(L.type == TAG_f); + S->labels[L.val].looprec_targeted = 1; + return 1; +} + +// Test whether this label was targeted by a loop_rec/2 instruction. +pred.smp_already_locked(L) { + ASSERT(L.type == TAG_u); + return S->labels[L.val].looprec_targeted; +} + + +// Sort map keys. Always succeeds unless the instruction contains +// invalid map keys (in which case loading will fail). +pred.map_key_sort(Size, Rest) { + return beam_load_map_key_sort(S, Size, Rest); +} diff --git a/erts/emulator/internal_doc/beam_makeops.md b/erts/emulator/internal_doc/beam_makeops.md index 1ec94d4ff9..f145cda964 100644 --- a/erts/emulator/internal_doc/beam_makeops.md +++ b/erts/emulator/internal_doc/beam_makeops.md @@ -986,33 +986,55 @@ instruction, it must only be used for a destination register.) * `o` - Overflow. An untagged integer that does not fit in a machine word. -#### Guard constraints #### +#### Guard constraints (predicates) #### If the constraints described so far is not enough, additional -constraints can be written in C in `beam_load.c` and be called as a -guard function on the left side of the transformation. If the guard -function returns a non-zero value, the matching of the rule will -continue, otherwise the match will fail. For example: +constraints can be implemented in C and be called as a guard function +on the left side of the transformation. If the guard function returns +a non-zero value, the matching of the rule will continue, otherwise +the match will fail. For example: ensure_map Lit=q | literal_is_map(Lit) => The guard test `literal_is_map/1` tests whether the given literal is a map. If the literal is a map, the instruction is unnecessary and can be removed. -It is outside the scope for this document to describe in detail how such -guard functions are written, but for the curious here is the implementation -of `literal_is_map()`: +Such guard tests are also called predicates. At the time of writing, all +predicates are defined in the file `predicates.tab`. - static int - literal_is_map(LoaderState* stp, GenOpArg Lit) - { +It is outside the scope for this document to describe in detail how +predicates are implemented because it requires knowledge of the +internal loader data structures, but here is the implementation of +`literal_is_map()`: + + pred.literal_is_map(Lit) { Eterm term; ASSERT(Lit.type == TAG_q); - term = stp->literals[Lit.val].term; + term = S->literals[Lit.val].term; return is_map(term); } +The `pred.` prefix tells **beam\_makeops** that this function is a +predicate. Without the prefix, it would have been interpreted as the +implementation of an instruction (described in **Defining the +implementation**). + +Predicate functions have a magic variabled called `S`, which is a +pointer to a state struct. In the example, `S->literals[Lit.val].term` +is used to retrieve the actual term for the literal. + +At the time of writing, the expanded C code generated by +**beam\_makeops** looks like this: + + static int literal_is_map(LoaderState* S, GenOpArg Lit) { + Eterm term; + + ASSERT(Lit.type == TAG_q); + term = S->literals[Lit.val].term; + return is_map(term);; + } + #### Handling instruction with variable number of operands #### Some instructions, such as `select_val/3`, essentially has a variable @@ -1100,24 +1122,24 @@ use as a temporary X register. #### Function call on the right side #### Transformations that are not possible to describe with the rule -language as described here can be written as a C function in -`beam_load.c` and called from the right side of a transformation. The -left side of the transformation will perform the match and bind -operands to variables. The variables can then be passed to a -generator function on the right side. For example: +language as described here can be implemented as a generator function +in C and called from the right side of a transformation. The left +side of the transformation will perform the match and bind operands to +variables. The variables can then be passed to a generator function +on the right side. For example: bif2 Fail=j u$bif:erlang:element/2 Index=s Tuple=xy Dst=d => \ - gen_element(Jump, Index, Tuple, Dst) + element(Jump, Index, Tuple, Dst) This transformation rule matches a call to the BIF `element/2`. -The operands will be captured and the function `gen_element()` will +The operands will be captured and the generator function `element()` will be called. -`gen_element()` will produce one of two instructions depending -on `Index`. If `Index` is an integer in the range from 1 up to -the maximum tuple size, the instruction `i_fast_element/2` will -be produced, otherwise the instruction `i_element/4` will be -produced. The corresponding specific instructions are: +The `element()` generator will produce one of two instructions +depending on `Index`. If `Index` is an integer in the range from 1 up +to the maximum tuple size, the instruction `i_fast_element/2` will be +produced, otherwise the instruction `i_element/4` will be produced. +The corresponding specific instructions are: i_fast_element xy j? I d i_element xy j? s d @@ -1128,31 +1150,29 @@ already an untagged integer. It also knows that the index is at least instruction will have to fetch the index from a register, test that it is an integer, and untag the integer. +At the time of writing, all generators functions were defined in the +file `generators.tab`. + It is outside the scope of this document to describe in detail how -generator functions are written, but for the curious, here is the -implementation of `gen_element()`: +generator functions are written, but here is the +implementation of `element()`: - static GenOp* - gen_element(LoaderState* stp, GenOpArg Fail, - GenOpArg Index, GenOpArg Tuple, GenOpArg Dst) - { + gen.element(Fail, Index, Tuple, Dst) { GenOp* op; - NEW_GENOP(stp, op); - op->arity = 4; - op->next = NULL; + $NewBeamOp(S, op); if (Index.type == TAG_i && Index.val > 0 && - Index.val <= ERTS_MAX_TUPLE_SIZE && - (Tuple.type == TAG_x || Tuple.type == TAG_y)) { - op->op = genop_i_fast_element_4; + Index.val <= ERTS_MAX_TUPLE_SIZE && + (Tuple.type == TAG_x || Tuple.type == TAG_y)) { + $BeamOpNameArity(op, i_fast_element, 4); 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; + $BeamOpNameArity(op, i_element, 4); op->a[0] = Tuple; op->a[1] = Fail; op->a[2] = Index; @@ -1162,6 +1182,15 @@ implementation of `gen_element()`: return op; } +The `gen.` prefix tells **beam\_makeops** that this function is a +generator. Without the prefix, it would have been interpreted as the +implementation of an instruction (described in **Defining the +implementation**). + +Generator functions have a magic variabled called `S`, which is a +pointer to a state struct. In the example, `S` is used in the invocation +of the `NewBeamOp` macro. + ### Defining the implementation ### The actual implementation of instructions are also defined in `.tab` diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops index f951a33567..4b71f6537c 100755 --- a/erts/emulator/utils/beam_makeops +++ b/erts/emulator/utils/beam_makeops @@ -97,6 +97,7 @@ my @obsolete; # Instructions and micro instructions implemented in C. my %c_code; # C code block, location, arguments. my %c_code_used; # Used or not. +my %c_param_types; # Types for predicates and generators. # Definitions for instructions combined from micro instructions. my %combined_instrs; @@ -109,7 +110,6 @@ my %unnumbered; my %is_transformed; - # # Pre-processor. # @@ -597,17 +597,7 @@ sub emulator_output { $name = "$outdir/beam_opcodes.c"; open(STDOUT, ">$name") || die "Failed to open $name for writing: $!\n"; comment('C'); - print "#ifdef HAVE_CONFIG_H\n"; - print "# include \"config.h\"\n"; - print "#endif\n\n"; - print '#include "sys.h"', "\n"; - print '#include "erl_vm.h"', "\n"; - print '#include "export.h"', "\n"; - print '#include "erl_process.h"', "\n"; - print '#include "bif.h"', "\n"; - print '#include "erl_atom_table.h"', "\n"; - print '#include "beam_load.h"', "\n"; - print "\n"; + include_files(); print "const char tag_to_letter[] = {\n "; for ($i = 0; $i < length($genop_types); $i++) { @@ -864,15 +854,19 @@ sub emulator_output { # Extension of transform engine. # - $name = "$outdir/beam_tr_funcs.h"; + $name = "$outdir/beam_transform.c"; open(STDOUT, ">$name") || die "Failed to open $name for writing: $!\n"; comment('C'); - tr_gen_call(@call_table); - - $name = "$outdir/beam_pred_funcs.h"; - open(STDOUT, ">$name") || die "Failed to open $name for writing: $!\n"; - comment('C'); - tr_gen_call(@pred_table); + include_files(); + print '#include "erl_term.h"', "\n"; + print '#include "erl_map.h"', "\n"; + print '#include "big.h"', "\n"; + print '#include "beam_transform_helpers.h"', "\n"; + print "\n"; + gen_tr_code('pred.'); + gen_tr_func('int', 'erts_beam_eval_predicate', @pred_table); + gen_tr_code('gen.'); + gen_tr_func('GenOp*', 'erts_beam_execute_transform', @call_table); # # Implementation of operations for emulator. @@ -2469,10 +2463,12 @@ sub tr_gen_from { my $var; my @args; my @vars; + my @param_types; foreach $var (@ops) { if ($var =~ /^-?\d+$/) { push @args, $var; + push @param_types, 'Uint'; next; } error($where, "'$var' unbound") @@ -2480,11 +2476,16 @@ sub tr_gen_from { push @vars, $var; if ($var_type{$var} eq 'scalar') { push(@args, "var[$var{$var}]"); + push @param_types, 'GenOpArg'; } else { push(@args, "rest_args"); + push @param_types, 'GenOpArg*'; } } - my $pi = tr_next_index(\@{pred_table}, \%pred_table, $name, @args); + my $c_name = "pred.$name"; + $c_param_types{$c_name} = \@param_types; + $c_code_used{$c_name} = 1; + my $pi = next_tr_index(\@{pred_table}, \%pred_table, $name, @args); my $op = make_op("$name()", 'pred', $pi); my @slots = grep(/^\d+/, map { $var{$_} } @vars); op_slot_usage($op, @slots); @@ -2654,18 +2655,24 @@ sub tr_gen_to { $name = $1; my $var; my(@args); + my @param_types; foreach $var (@ops) { error($where, "variable '$var' unbound") unless defined $var{$var}; if ($var_type{$var} eq 'scalar') { - push(@args, "var[$var{$var}]"); + push @args, "var[$var{$var}]"; + push @param_types, 'GenOpArg'; } else { - push(@args, "rest_args"); + push @args, "rest_args"; + push @param_types, 'GenOpArg*'; } } + my $c_name = "gen.$name"; + $c_param_types{$c_name} = \@param_types; + $c_code_used{$c_name} = 1; pop(@code); # Get rid of 'commit' instruction - my $index = tr_next_index(\@call_table, \%call_table, + my $index = next_tr_index(\@call_table, \%call_table, $name, @args); my $op = make_op("$name()", 'call_end', $index); my @slots = grep(/^\d+/, map { $var{$_} } @ops); @@ -3027,6 +3034,39 @@ sub tr_remove_unused { } } +sub gen_tr_code { + my($prefix) = @_; + + foreach my $name (sort keys %c_code) { + if (index($name, $prefix) == 0) { + my $func_name = $name; + $func_name =~ s/^$prefix//; + my($block,$where,@params) = @{$c_code{$name}}; + my %bindings; + $block = eval { expand_all($block, \%bindings) }; + unless (defined $block) { + warn $@; + error("... from the body of $name at $where"); + } + my $head = 'static '; + $head .= $prefix eq 'pred.' ? 'int' : 'GenOp*'; + $head .= " $func_name(LoaderState* S"; + my(@param_types); + if (defined $c_param_types{$name}) { + @param_types = @{$c_param_types{$name}}; + } else { + @param_types = ('GenOpArg') x @params; + } + for (my $i = 0; $i < @params; $i++) { + $head .= ", $param_types[$i] $params[$i]"; + } + $head .= ") {\n"; + my $code = $head . "$block;\n}\n"; + print_indented_code($code); + } + } +} + sub code_len { my($sum) = 0; my($ref); @@ -3063,9 +3103,9 @@ sub starred_comment { "\n/*" . join("\n * ", '', @_) . "\n */\n\n"; } -sub tr_next_index { +sub next_tr_index { my($lref,$href,$name,@args) = @_; - my $code = "RVAL = $name(" . join(', ', 'st', @args) . "); break;\n"; + my $code = "return $name(" . join(', ', 'st', @args) . ");\n"; my $index; if (defined $$href{$code}) { @@ -3078,11 +3118,29 @@ sub tr_next_index { $index; } -sub tr_gen_call { - my(@call_table) = @_; - my($i); +sub gen_tr_func { + my($type,$name,@call_table) = @_; - for ($i = 0; $i < @call_table; $i++) { - print "case $i: $call_table[$i]"; + print "$type $name(unsigned int op, LoaderState* st, GenOpArg var[], GenOpArg* rest_args) {\n"; + print " switch (op) {\n"; + for (my $i = 0; $i < @call_table; $i++) { + print " case $i: $call_table[$i]"; } + print qq[ default: erts_exit(ERTS_ABORT_EXIT, "$name: invalid op %d\\n", op);]; + print " }\n"; + print "}\n\n"; +} + +sub include_files() { + print "#ifdef HAVE_CONFIG_H\n"; + print "# include \"config.h\"\n"; + print "#endif\n\n"; + print '#include "sys.h"', "\n"; + print '#include "erl_vm.h"', "\n"; + print '#include "export.h"', "\n"; + print '#include "erl_process.h"', "\n"; + print '#include "bif.h"', "\n"; + print '#include "erl_atom_table.h"', "\n"; + print '#include "beam_load.h"', "\n"; + print "\n"; } -- 2.26.2
Locations
Projects
Search
Status Monitor
Help
OpenBuildService.org
Documentation
API Documentation
Code of Conduct
Contact
Support
@OBShq
Terms
openSUSE Build Service is sponsored by
The Open Build Service is an
openSUSE project
.
Sign Up
Log In
Places
Places
All Projects
Status Monitor