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
