diff options
Diffstat (limited to 'erts/emulator/beam/beam_load.c')
| -rw-r--r-- | erts/emulator/beam/beam_load.c | 5234 |
1 files changed, 5234 insertions, 0 deletions
diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c new file mode 100644 index 0000000000..47dd98117d --- /dev/null +++ b/erts/emulator/beam/beam_load.c @@ -0,0 +1,5234 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include "erl_vm.h" +#include "global.h" +#include "erl_version.h" +#include "erl_process.h" +#include "error.h" +#include "erl_driver.h" +#include "bif.h" +#include "external.h" +#include "beam_load.h" +#include "big.h" +#include "erl_bits.h" +#include "beam_catches.h" +#include "erl_binary.h" +#include "erl_zlib.h" + +#ifdef HIPE +#include "hipe_bif0.h" +#include "hipe_mode_switch.h" +#include "hipe_arch.h" +#endif + +ErlDrvBinary* erts_gzinflate_buffer(char*, int); + +#define MAX_OPARGS 8 +#define CALLED 0 +#define DEFINED 1 +#define EXPORTED 2 + +#ifdef NO_JUMP_TABLE +# define BeamOpCode(Op) ((Uint)(Op)) +#else +# define BeamOpCode(Op) ((Eterm)beam_ops[Op]) +#endif + +#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) + +typedef struct { + Uint value; /* Value of label (NULL if not known yet). */ + Uint patches; /* Index (into code buffer) to first location + * which must be patched with the value of this label. + */ +#ifdef ERTS_SMP + Uint looprec_targeted; /* Non-zero if this label is the target of a loop_rec + * instruction. + */ +#endif +} Label; + +/* + * Type for a operand for a generic instruction. + */ + +typedef struct { + unsigned type; /* Type of operand. */ + Uint val; /* Value of operand. */ + Uint bigarity; /* Arity for bignumbers (only). */ +} GenOpArg; + +/* + * A generic operation. + */ + +typedef struct genop { + 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. + */ + BifFunction bf; /* Pointer to BIF function 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. */ + Eterm* address; /* Address to function in code. */ +} ExportEntry; + +#define MakeIffId(a, b, c, d) \ + (((Uint) (a) << 24) | ((Uint) (b) << 16) | ((Uint) (c) << 8) | (Uint) (d)) + +#define ATOM_CHUNK 0 +#define CODE_CHUNK 1 +#define STR_CHUNK 2 +#define IMP_CHUNK 3 +#define EXP_CHUNK 4 +#define NUM_MANDATORY 5 + +#define LAMBDA_CHUNK 5 +#define LITERAL_CHUNK 6 +#define ATTR_CHUNK 7 +#define COMPILE_CHUNK 8 + +#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[] = { + /* + * Mandatory chunk types -- these MUST be present. + */ + MakeIffId('A', 't', 'o', 'm'), /* 0 */ + MakeIffId('C', 'o', 'd', 'e'), /* 1 */ + MakeIffId('S', 't', 'r', 'T'), /* 2 */ + MakeIffId('I', 'm', 'p', 'T'), /* 3 */ + MakeIffId('E', 'x', 'p', 'T'), /* 4 */ + + /* + * Optional chunk types -- the loader will use them if present. + */ + MakeIffId('F', 'u', 'n', 'T'), /* 5 */ + MakeIffId('L', 'i', 't', 'T'), /* 6 */ + MakeIffId('A', 't', 't', 'r'), /* 7 */ + MakeIffId('C', 'I', 'n', 'f'), /* 8 */ +}; + +/* + * 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). */ + Uint heap_size; /* (Exact) size on the heap. */ + Uint offset; /* Offset from temporary location to final. */ + Eterm* heap; /* Heap for term. */ +} 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 { + int 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 contains all information about the module being loaded. + */ + +typedef struct { + /* + * 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. */ + + /* + * 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). */ + int num_functions; /* Number of functions in module. */ + int num_labels; /* Number of labels. */ + int code_buffer_size; /* Size of code buffer in words. */ + Eterm* code; /* Loaded code. */ + int ci; /* Current index into loaded code. */ + Label* labels; + Uint put_strings; /* Linked list of put_string instructions. */ + Uint new_bs_put_strings; /* Linked list of i_new_bs_put_string instructions. */ + StringPatch* string_patches; /* Linked list of position into string table to patch. */ + Uint catches; /* Linked list of catch_yf instructions. */ + unsigned loaded_size; /* Final size of code when loaded. */ + byte mod_md5[16]; /* 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) + */ + + /* + * Atom table. + */ + + int num_atoms; /* Number of atoms in atom table. */ + Eterm* atom; /* Atom table. */ + + int num_exps; /* Number of exports. */ + ExportEntry* export; /* Pointer to export table. */ + + 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. + */ + + int num_lambdas; /* Number of lambdas in table. */ + 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). + */ + + int num_literals; /* Number of literals in table. */ + 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. */ + + /* + * Floating point. + */ + int new_float_instructions; /* New allocation scheme for floating point. */ +} LoaderState; + +typedef struct { + unsigned num_functions; /* Number of functions. */ + Eterm* func_tab[1]; /* Pointers to each function. */ +} LoadedCode; + +#define GetTagAndValue(Stp, Tag, Val) \ + do { \ + Uint __w; \ + GetByte(Stp, __w); \ + Tag = __w & 0x07; \ + if ((__w & 0x08) == 0) { \ + Val = __w >> 4; \ + } else if ((__w & 0x10) == 0) { \ + Val = ((__w >> 5) << 8); \ + GetByte(Stp, __w); \ + Val |= __w; \ + } else { \ + if (!get_int_val(Stp, __w, &(Val))) goto load_error; \ + } \ + } while (0) + + +#define LoadError0(Stp, Fmt) \ + do { \ + load_printf(__LINE__, Stp, Fmt); \ + goto load_error; \ + } while (0) + +#define LoadError1(Stp, Fmt, Arg1) \ + do { \ + load_printf(__LINE__, stp, Fmt, Arg1); \ + goto load_error; \ + } while (0) + +#define LoadError2(Stp, Fmt, Arg1, Arg2) \ + do { \ + load_printf(__LINE__, Stp, Fmt, Arg1, Arg2); \ + goto load_error; \ + } while (0) + +#define LoadError3(Stp, Fmt, Arg1, Arg2, Arg3) \ + do { \ + load_printf(__LINE__, stp, Fmt, Arg1, Arg2, Arg3); \ + goto load_error; \ + } while (0) + +#define EndOfFile(Stp) (stp->file_left == 0) + +#define GetInt(Stp, N, Dest) \ + if (Stp->file_left < (N)) { \ + short_file(__LINE__, Stp, (N)); \ + goto load_error; \ + } else { \ + int __n = (N); \ + Uint __result = 0; \ + Stp->file_left -= (unsigned) __n; \ + while (__n-- > 0) { \ + __result = __result << 8 | *Stp->file_p++; \ + } \ + Dest = __result; \ + } while (0) + +#define GetByte(Stp, Dest) \ + if ((Stp)->file_left < 1) { \ + short_file(__LINE__, (Stp), 1); \ + goto load_error; \ + } else { \ + Dest = *(Stp)->file_p++; \ + (Stp)->file_left--; \ + } + +#define GetString(Stp, Dest, N) \ + if (Stp->file_left < (N)) { \ + short_file(__LINE__, Stp, (N)); \ + goto load_error; \ + } else { \ + Dest = (Stp)->file_p; \ + (Stp)->file_p += (N); \ + (Stp)->file_left -= (N); \ + } + +#define GetAtom(Stp, Index, Dest) \ + if ((Index) == 0) { \ + LoadError1((Stp), "bad atom index 0 ([]) in %s", stp->file_name); \ + } else if ((Index) < (Stp)->num_atoms) { \ + Dest = (Stp)->atom[(Index)]; \ + } else { \ + LoadError2((Stp), "bad atom index %d in %s", (Index), stp->file_name); \ + } + +#ifdef DEBUG +# define GARBAGE 0xCC +# define DEBUG_INIT_GENOP(Dst) 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) \ + 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_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) + + +static int bin_load(Process *c_p, ErtsProcLocks c_p_locks, + Eterm group_leader, Eterm* modp, byte* bytes, int unloaded_size); +static void init_state(LoaderState* stp); +static int insert_new_code(Process *c_p, ErtsProcLocks c_p_locks, + Eterm group_leader, Eterm module, + Eterm* code, Uint size, Uint catches); +static int scan_iff_file(LoaderState* stp, Uint* chunk_types, + Uint num_types, Uint num_mandatory); +static int load_atom_table(LoaderState* stp); +static int load_import_table(LoaderState* stp); +static int read_export_table(LoaderState* stp); +static int read_lambda_table(LoaderState* stp); +static int read_literal_table(LoaderState* stp); +static int read_code_header(LoaderState* stp); +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 Fail, + GenOpArg Size, GenOpArg* Rest); +static GenOp* gen_select_val(LoaderState* stp, GenOpArg S, GenOpArg Fail, + GenOpArg Size, GenOpArg* Rest); +static GenOp* gen_select_big(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_func_info(LoaderState* stp, GenOpArg mod, GenOpArg Func, + GenOpArg arity, GenOpArg label); +static GenOp* +gen_guard_bif(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif, + GenOpArg Src, GenOpArg Dst); + +static int freeze_code(LoaderState* stp); + +static void final_touch(LoaderState* stp); +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_int_val(LoaderState* stp, Uint len_code, Uint* result); +static int get_erlang_integer(LoaderState* stp, Uint len_code, Uint* 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 Uint new_literal(LoaderState* stp, Eterm** hpp, Uint heap_size); +static int genopargcompare(GenOpArg* a, GenOpArg* b); +static Eterm exported_from_module(Process* p, Eterm mod); +static Eterm functions_in_module(Process* p, Eterm mod); +static Eterm attributes_for_module(Process* p, Eterm mod); +static Eterm compilation_info_for_module(Process* p, Eterm mod); +static Eterm native_addresses(Process* p, Eterm mod); +int patch_funentries(Eterm Patchlist); +int patch(Eterm Addresses, Uint fe); +static int safe_mul(Uint a, Uint b, Uint* resp); + + +static int must_swap_floats; + +/* + * The following variables keep a sorted list of address ranges for + * each module. It allows us to quickly find a function given an + * instruction pointer. + */ +Range* modules = NULL; /* Sorted lists of module addresses. */ +int num_loaded_modules; /* Number of loaded modules. */ +int allocated_modules; /* Number of slots allocated. */ +Range* mid_module = NULL; /* Cached search start point */ + +Uint erts_total_code_size; +/**********************************************************************/ + + +void init_load(void) +{ + FloatDef f; + + erts_total_code_size = 0; + + beam_catches_init(); + + f.fd = 1.0; + must_swap_floats = (f.fw[0] == 0); + + allocated_modules = 128; + modules = (Range *) erts_alloc(ERTS_ALC_T_MODULE_REFS, + allocated_modules*sizeof(Range)); + mid_module = modules; + num_loaded_modules = 0; +} + +static void +define_file(LoaderState* stp, char* name, int idx) +{ + stp->file_name = name; + stp->file_p = stp->chunks[idx].start; + stp->file_left = stp->chunks[idx].size; +} + +int +erts_load_module(Process *c_p, + ErtsProcLocks c_p_locks, + Eterm group_leader, /* Group leader or NIL if none. */ + Eterm* modp, /* + * Module name as an atom (NIL to not check). + * On return, contains the actual module name. + */ + byte* code, /* Points to the code to load */ + int size) /* Size of code to load. */ +{ + ErlDrvBinary* bin; + int result; + + if (size >= 4 && code[0] == 'F' && code[1] == 'O' && + code[2] == 'R' && code[3] == '1') { + /* + * The BEAM module is not compressed. + */ + result = bin_load(c_p, c_p_locks, group_leader, modp, code, size); + } else { + /* + * The BEAM module is compressed (or possibly invalid/corrupted). + */ + if ((bin = (ErlDrvBinary *) erts_gzinflate_buffer((char*)code, size)) == NULL) { + return -1; + } + result = bin_load(c_p, c_p_locks, group_leader, modp, + (byte*)bin->orig_bytes, bin->orig_size); + driver_free_binary(bin); + } + return result; +} + + +static int +bin_load(Process *c_p, ErtsProcLocks c_p_locks, + Eterm group_leader, Eterm* modp, byte* bytes, int unloaded_size) +{ + LoaderState state; + int rval = -1; + + init_state(&state); + state.module = *modp; + state.group_leader = group_leader; + + /* + * Scan the IFF file. + */ + + state.file_name = "IFF header for Beam file"; + state.file_p = bytes; + state.file_left = unloaded_size; + if (!scan_iff_file(&state, chunk_types, NUM_CHUNK_TYPES, NUM_MANDATORY)) { + goto load_error; + } + + /* + * Read the header for the code chunk. + */ + + define_file(&state, "code chunk header", CODE_CHUNK); + if (!read_code_header(&state)) { + goto load_error; + } + + /* + * Read the atom table. + */ + + define_file(&state, "atom table", ATOM_CHUNK); + if (!load_atom_table(&state)) { + goto load_error; + } + + /* + * Read the import table. + */ + + define_file(&state, "import table", IMP_CHUNK); + if (!load_import_table(&state)) { + goto load_error; + } + + /* + * Read the lambda (fun) table. + */ + + if (state.chunks[LAMBDA_CHUNK].size > 0) { + define_file(&state, "lambda (fun) table", LAMBDA_CHUNK); + if (!read_lambda_table(&state)) { + goto load_error; + } + } + + /* + * Read the literal table. + */ + + if (state.chunks[LITERAL_CHUNK].size > 0) { + define_file(&state, "literals table (constant pool)", LITERAL_CHUNK); + if (!read_literal_table(&state)) { + goto load_error; + } + } + + /* + * Load the code chunk. + */ + + state.file_name = "code chunk"; + state.file_p = state.code_start; + state.file_left = state.code_size; + if (!load_code(&state) || !freeze_code(&state)) { + goto load_error; + } + + /* + * Read and validate the export table. (This must be done after + * loading the code, because it contains labels.) + */ + + define_file(&state, "export table", EXP_CHUNK); + if (!read_export_table(&state)) { + goto load_error; + } + + /* + * Ready for the final touch: fixing the export table entries for + * exported and imported functions. This can't fail. + */ + + rval = insert_new_code(c_p, c_p_locks, state.group_leader, state.module, + state.code, state.loaded_size, state.catches); + if (rval < 0) { + goto load_error; + } + final_touch(&state); + + /* + * Loading succeded. + */ + rval = 0; + state.code = NULL; /* Prevent code from being freed. */ + *modp = state.module; + + /* + * If there is an on_load function, signal an error to + * indicate that the on_load function must be run. + */ + if (state.on_load) { + rval = -5; + } + + load_error: + if (state.code != 0) { + erts_free(ERTS_ALC_T_CODE, state.code); + } + if (state.labels != NULL) { + erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.labels); + } + if (state.atom != NULL) { + erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.atom); + } + if (state.import != NULL) { + erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.import); + } + if (state.export != NULL) { + erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.export); + } + if (state.lambdas != state.def_lambdas) { + erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.lambdas); + } + if (state.literals != NULL) { + int i; + for (i = 0; i < state.num_literals; i++) { + if (state.literals[i].heap != NULL) { + erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.literals[i].heap); + } + } + erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.literals); + } + while (state.literal_patches != NULL) { + LiteralPatch* next = state.literal_patches->next; + erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.literal_patches); + state.literal_patches = next; + } + while (state.string_patches != NULL) { + StringPatch* next = state.string_patches->next; + erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.string_patches); + state.string_patches = next; + } + while (state.genop_blocks) { + GenOpBlock* next = state.genop_blocks->next; + erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.genop_blocks); + state.genop_blocks = next; + } + + return rval; +} + + +static void +init_state(LoaderState* stp) +{ + stp->function = THE_NON_VALUE; /* Function not known yet */ + stp->arity = 0; + stp->specific_op = -1; + stp->genop = NULL; + stp->atom = NULL; + stp->code = NULL; + stp->labels = NULL; + stp->import = NULL; + stp->export = NULL; + stp->free_genop = NULL; + stp->genop_blocks = NULL; + stp->num_lambdas = 0; + stp->lambdas_allocated = sizeof(stp->def_lambdas)/sizeof(Lambda); + stp->lambdas = stp->def_lambdas; + stp->lambda_error = NULL; + stp->num_literals = 0; + stp->allocated_literals = 0; + stp->literals = 0; + stp->total_literal_size = 0; + stp->literal_patches = 0; + stp->string_patches = 0; + stp->new_float_instructions = 0; + stp->may_load_nif = 0; + stp->on_load = 0; +} + +static int +insert_new_code(Process *c_p, ErtsProcLocks c_p_locks, + Eterm group_leader, Eterm module, Eterm* code, Uint size, Uint catches) +{ + Module* modp; + int rval; + int i; + + if ((rval = beam_make_current_old(c_p, c_p_locks, module)) < 0) { + erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); + erts_dsprintf(dsbufp, + "Module %T must be purged before loading\n", + module); + erts_send_error_to_logger(group_leader, dsbufp); + return rval; + } + + /* + * Update module table. + */ + + erts_total_code_size += size; + modp = erts_put_module(module); + modp->code = code; + modp->code_length = size; + modp->catches = catches; + + /* + * Update address table (used for finding a function from a PC value). + */ + + if (num_loaded_modules == allocated_modules) { + allocated_modules *= 2; + modules = (Range *) erts_realloc(ERTS_ALC_T_MODULE_REFS, + (void *) modules, + allocated_modules * sizeof(Range)); + } + for (i = num_loaded_modules; i > 0; i--) { + if (code > modules[i-1].start) { + break; + } + modules[i] = modules[i-1]; + } + modules[i].start = code; + modules[i].end = (Eterm *) (((byte *)code) + size); + num_loaded_modules++; + mid_module = &modules[num_loaded_modules/2]; + return 0; +} + +static int +scan_iff_file(LoaderState* stp, Uint* chunk_types, Uint num_types, Uint num_mandatory) +{ + MD5_CTX context; + Uint id; + Uint count; + int i; + + /* + * The binary must start with an IFF 'FOR1' chunk. + */ + + GetInt(stp, 4, id); + if (id != MakeIffId('F', 'O', 'R', '1')) { + LoadError0(stp, "not a BEAM file: no IFF 'FOR1' chunk"); + } + + /* + * Retrieve the chunk size and verify it. If the size is equal to + * or less than the size of the binary, it is ok and we will use it + * as the limit for the logical file size. + */ + + GetInt(stp, 4, count); + if (count > stp->file_left) { + LoadError2(stp, "form size %ld greater than size %ld of binary", + count, stp->file_left); + } + stp->file_left = count; + + /* + * Verify that this is a BEAM file. + */ + + GetInt(stp, 4, id); + if (id != MakeIffId('B', 'E', 'A', 'M')) { + LoadError0(stp, "not a BEAM file: IFF form type is not 'BEAM'"); + } + + /* + * Initialize the chunks[] array in the state. + */ + + for (i = 0; i < num_types; i++) { + stp->chunks[i].start = NULL; + stp->chunks[i].size = 0; + } + + /* + * Now we can go ahead and read all chunks in the BEAM form. + */ + + while (!EndOfFile(stp)) { + + /* + * Read the chunk id and verify that it contains ASCII characters. + */ + GetInt(stp, 4, id); + for (i = 0; i < 4; i++) { + unsigned c = (id >> i*8) & 0xff; + if (c < ' ' || c > 0x7E) { + LoadError1(stp, "non-ascii garbage '%lx' instead of chunk type id", + id); + } + } + + /* + * Read the count and verify it. + */ + + GetInt(stp, 4, count); + if (count > stp->file_left) { + LoadError2(stp, "chunk size %ld for '%lx' greater than size %ld of binary", + count, stp->file_left); + } + + /* + * See if the chunk is useful for the loader. + */ + for (i = 0; i < num_types; i++) { + if (chunk_types[i] == id) { + stp->chunks[i].start = stp->file_p; + stp->chunks[i].size = count; + break; + } + } + + /* + * Go on to the next chunk. + */ + count = 4*((count+3)/4); + stp->file_p += count; + stp->file_left -= count; + } + + /* + * At this point, we have read the entire IFF file, and we + * know that it is syntactically correct. + * + * Now check that it contains all mandatory chunks. At the + * same time calculate the MD5 for the module. + */ + + MD5Init(&context); + for (i = 0; i < num_mandatory; i++) { + if (stp->chunks[i].start != NULL) { + MD5Update(&context, stp->chunks[i].start, stp->chunks[i].size); + } else { + char sbuf[5]; + + id_to_string(chunk_types[i], sbuf); + LoadError1(stp, "mandatory chunk of type '%s' not found\n", sbuf); + } + } + if (LITERAL_CHUNK < num_types) { + if (stp->chunks[LAMBDA_CHUNK].start != 0) { + byte* start = stp->chunks[LAMBDA_CHUNK].start; + Uint left = stp->chunks[LAMBDA_CHUNK].size; + + /* + * The idea here is to ignore the OldUniq field for the fun; it is + * based on the old broken hash function, which can be different + * on little endian and big endian machines. + */ + if (left >= 4) { + static byte zero[4]; + MD5Update(&context, start, 4); + start += 4; + left -= 4; + + while (left >= 24) { + /* Include: Function Arity Index NumFree */ + MD5Update(&context, start, 20); + /* Set to zero: OldUniq */ + MD5Update(&context, zero, 4); + start += 24; + left -= 24; + } + } + /* Can't happen for a correct 'FunT' chunk */ + if (left > 0) { + MD5Update(&context, start, left); + } + } + if (stp->chunks[LITERAL_CHUNK].start != 0) { + MD5Update(&context, stp->chunks[LITERAL_CHUNK].start, + stp->chunks[LITERAL_CHUNK].size); + } + } + MD5Final(stp->mod_md5, &context); + return 1; + + load_error: + return 0; +} + + +static int +load_atom_table(LoaderState* stp) +{ + int i; + + GetInt(stp, 4, stp->num_atoms); + stp->num_atoms++; + stp->atom = erts_alloc(ERTS_ALC_T_LOADER_TMP, + erts_next_heap_size((stp->num_atoms*sizeof(Eterm)), + 0)); + + /* + * Read all atoms. + */ + + for (i = 1; i < stp->num_atoms; i++) { + byte* atom; + Uint n; + + GetByte(stp, n); + GetString(stp, atom, n); + stp->atom[i] = am_atom_put((char*)atom, n); + } + + /* + * Check the module name if a module name was given. + */ + + if (is_nil(stp->module)) { + stp->module = stp->atom[1]; + } else if (stp->atom[1] != stp->module) { + char sbuf[256]; + Atom* ap; + + ap = atom_tab(atom_val(stp->atom[1])); + memcpy(sbuf, ap->name, ap->len); + sbuf[ap->len] = '\0'; + LoadError1(stp, "module name in object code is %s", sbuf); + } + + return 1; + + load_error: + return 0; +} + + +static int +load_import_table(LoaderState* stp) +{ + int i; + + GetInt(stp, 4, stp->num_imports); + stp->import = erts_alloc(ERTS_ALC_T_LOADER_TMP, + erts_next_heap_size((stp->num_imports * + sizeof(ImportEntry)), + 0)); + for (i = 0; i < stp->num_imports; i++) { + int n; + Eterm mod; + Eterm func; + Uint arity; + Export* e; + + GetInt(stp, 4, n); + if (n >= stp->num_atoms) { + LoadError2(stp, "import entry %d: invalid atom number %d", i, n); + } + mod = stp->import[i].module = stp->atom[n]; + GetInt(stp, 4, n); + if (n >= stp->num_atoms) { + LoadError2(stp, "import entry %d: invalid atom number %d", i, n); + } + func = stp->import[i].function = stp->atom[n]; + GetInt(stp, 4, arity); + if (arity > MAX_REG) { + LoadError2(stp, "import entry %d: invalid arity %d", i, arity); + } + stp->import[i].arity = arity; + stp->import[i].patches = 0; + stp->import[i].bf = NULL; + + /* + * If the export entry refers to a BIF, get the pointer to + * the BIF function. + */ + if ((e = erts_find_export_entry(mod, func, arity)) != NULL) { + if (e->code[3] == (Uint) em_apply_bif) { + stp->import[i].bf = (BifFunction) e->code[4]; + if (func == am_load_nif && mod == am_erlang && arity == 2) { + stp->may_load_nif = 1; + } + } + } + } + return 1; + + load_error: + return 0; +} + + +static int +read_export_table(LoaderState* stp) +{ + static struct { + Eterm mod; + Eterm func; + int arity; + } allow_redef[] = { + /* The BIFs that are allowed to be redefined by Erlang code */ + {am_erlang,am_apply,2}, + {am_erlang,am_apply,3}, + }; + int i; + + GetInt(stp, 4, stp->num_exps); + if (stp->num_exps > stp->num_functions) { + LoadError2(stp, "%d functions exported; only %d functions defined", + stp->num_exps, stp->num_functions); + } + stp->export + = (ExportEntry *) erts_alloc(ERTS_ALC_T_LOADER_TMP, + (stp->num_exps * sizeof(ExportEntry))); + + for (i = 0; i < stp->num_exps; i++) { + Uint n; + Uint value; + Eterm func; + Uint arity; + Export* e; + + GetInt(stp, 4, n); + GetAtom(stp, n, func); + stp->export[i].function = func; + GetInt(stp, 4, arity); + if (arity > MAX_REG) { + LoadError2(stp, "export table entry %d: absurdly high arity %d", i, arity); + } + stp->export[i].arity = arity; + GetInt(stp, 4, n); + if (n >= stp->num_labels) { + LoadError3(stp, "export table entry %d: invalid label %d (highest defined label is %d)", i, n, stp->num_labels); + } + value = stp->labels[n].value; + if (value == 0) { + LoadError2(stp, "export table entry %d: label %d not resolved", i, n); + } + stp->export[i].address = stp->code + value; + + /* + * Check that we are not redefining a BIF (except the ones allowed to + * redefine). + */ + if ((e = erts_find_export_entry(stp->module, func, arity)) != NULL) { + if (e->code[3] == (Uint) em_apply_bif) { + int j; + + for (j = 0; j < sizeof(allow_redef)/sizeof(allow_redef[0]); j++) { + if (stp->module == allow_redef[j].mod && + func == allow_redef[j].func && + arity == allow_redef[j].arity) { + break; + } + } + if (j == sizeof(allow_redef)/sizeof(allow_redef[0])) { + LoadError2(stp, "exported function %T/%d redefines BIF", + func, arity); + } + } + } + } + return 1; + + load_error: + return 0; +} + +static int +read_lambda_table(LoaderState* stp) +{ + int i; + + GetInt(stp, 4, stp->num_lambdas); + stp->lambdas_allocated = stp->num_lambdas; + stp->lambdas = (Lambda *) erts_alloc(ERTS_ALC_T_LOADER_TMP, + stp->num_lambdas * sizeof(Lambda)); + for (i = 0; i < stp->num_lambdas; i++) { + Uint n; + Uint32 Index; + Uint32 OldUniq; + ErlFunEntry* fe; + Uint arity; + + GetInt(stp, 4, n); /* Function. */ + GetAtom(stp, n, stp->lambdas[i].function); + GetInt(stp, 4, arity); + if (arity > MAX_REG) { + LoadError2(stp, "lambda entry %d: absurdly high arity %d", i, arity); + } + stp->lambdas[i].arity = arity; + GetInt(stp, 4, n); + if (n >= stp->num_labels) { + LoadError3(stp, "lambda entry %d: invalid label %d (highest defined label is %d)", + i, n, stp->num_labels); + } + stp->lambdas[i].label = n; + GetInt(stp, 4, Index); + GetInt(stp, 4, stp->lambdas[i].num_free); + GetInt(stp, 4, OldUniq); + fe = erts_put_fun_entry2(stp->module, OldUniq, i, stp->mod_md5, + Index, arity-stp->lambdas[i].num_free); + stp->lambdas[i].fe = fe; + } + return 1; + + load_error: + return 0; +} + +static int +read_literal_table(LoaderState* stp) +{ + int i; + Uint uncompressed_sz; + byte* uncompressed = 0; + + GetInt(stp, 4, uncompressed_sz); + uncompressed = erts_alloc(ERTS_ALC_T_TMP, uncompressed_sz); + if (erl_zlib_uncompress(uncompressed, &uncompressed_sz, + stp->file_p, stp->file_left) != Z_OK) { + LoadError0(stp, "failed to uncompress literal table (constant pool)"); + } + stp->file_p = uncompressed; + stp->file_left = uncompressed_sz; + GetInt(stp, 4, stp->num_literals); + stp->literals = (Literal *) erts_alloc(ERTS_ALC_T_LOADER_TMP, + stp->num_literals * sizeof(Literal)); + stp->allocated_literals = stp->num_literals; + + for (i = 0; i < stp->num_literals; i++) { + stp->literals[i].heap = 0; + } + + for (i = 0; i < stp->num_literals; i++) { + int sz; + Sint heap_size; + byte* p; + Eterm val; + Eterm* hp; + + GetInt(stp, 4, sz); /* Size of external term format. */ + GetString(stp, p, sz); + if ((heap_size = erts_decode_ext_size(p, sz, 1)) < 0) { + LoadError1(stp, "literal %d: bad external format", i); + } + hp = stp->literals[i].heap = erts_alloc(ERTS_ALC_T_LOADER_TMP, + heap_size*sizeof(Eterm)); + val = erts_decode_ext(&hp, NULL, &p); + stp->literals[i].heap_size = hp - stp->literals[i].heap; + if (stp->literals[i].heap_size > heap_size) { + erl_exit(1, "overrun by %d word(s) for literal heap, term %d", + stp->literals[i].heap_size - heap_size, i); + } + if (is_non_value(val)) { + LoadError1(stp, "literal %d: bad external format", i); + } + stp->literals[i].term = val; + stp->total_literal_size += stp->literals[i].heap_size; + } + erts_free(ERTS_ALC_T_TMP, uncompressed); + return 1; + + load_error: + if (uncompressed) { + erts_free(ERTS_ALC_T_TMP, uncompressed); + } + return 0; +} + + +static int +read_code_header(LoaderState* stp) +{ + unsigned head_size; + unsigned version; + unsigned opcode_max; + int i; + + /* + * Read size of sub-header for code information and from it calculate + * where the code begins. Also, use the size to limit the file size + * for header reading, so that we automatically get an error if the + * size is set too small. + */ + + GetInt(stp, 4, head_size); + stp->code_start = stp->file_p + head_size; + stp->code_size = stp->file_left - head_size; + stp->file_left = head_size; + + /* + * Get and verify version of instruction set. + */ + + GetInt(stp, 4, version); + if (version != BEAM_FORMAT_NUMBER) { + LoadError2(stp, "wrong instruction set %d; expected %d", + version, BEAM_FORMAT_NUMBER); + } + + /* + * Verify the number of the highest opcode used. + */ + + GetInt(stp, 4, opcode_max); + if (opcode_max > MAX_GENERIC_OPCODE) { + LoadError2(stp, "use of opcode %d; this emulator supports only up to %d", + opcode_max, MAX_GENERIC_OPCODE); + } + + GetInt(stp, 4, stp->num_labels); + GetInt(stp, 4, stp->num_functions); + + /* + * Initialize label table. + */ + + stp->labels = (Label *) erts_alloc(ERTS_ALC_T_LOADER_TMP, + stp->num_labels * sizeof(Label)); + for (i = 0; i < stp->num_labels; i++) { + stp->labels[i].value = 0; + stp->labels[i].patches = 0; +#ifdef ERTS_SMP + stp->labels[i].looprec_targeted = 0; +#endif + } + + /* + * Initialize code area. + */ + stp->code_buffer_size = erts_next_heap_size(2048 + stp->num_functions, 0); + stp->code = (Eterm*) erts_alloc(ERTS_ALC_T_CODE, + sizeof(Eterm) * stp->code_buffer_size); + + stp->code[MI_NUM_FUNCTIONS] = stp->num_functions; + stp->ci = MI_FUNCTIONS + stp->num_functions + 1; + + stp->code[MI_ATTR_PTR] = 0; + stp->code[MI_ATTR_SIZE_ON_HEAP] = 0; + stp->code[MI_COMPILE_PTR] = 0; + stp->code[MI_COMPILE_SIZE_ON_HEAP] = 0; + stp->code[MI_NUM_BREAKPOINTS] = 0; + + stp->put_strings = 0; + stp->new_bs_put_strings = 0; + stp->catches = 0; + return 1; + + load_error: + return 0; +} + + +#define VerifyTag(Stp, Actual, Expected) \ + if (Actual != Expected) { \ + LoadError2(Stp, "bad tag %d; expected %d", Actual, Expected); \ + } else {} + +#define Need(w) \ + ASSERT(ci <= code_buffer_size); \ + if (code_buffer_size < ci+(w)) { \ + code_buffer_size = erts_next_heap_size(ci+(w), 0); \ + stp->code = code \ + = (Eterm *) erts_realloc(ERTS_ALC_T_CODE, \ + (void *) code, \ + code_buffer_size * sizeof(Eterm)); \ + } + + + +static int +load_code(LoaderState* stp) +{ + int i; + int tmp; + int ci; + int last_func_start = 0; + char* sign; + int arg; /* Number of current argument. */ + int num_specific; /* Number of specific ops for current. */ + Eterm* code; + int code_buffer_size; + int specific; + Uint last_label = 0; /* Number of last label. */ + Uint function_number = 0; + GenOp* last_op = NULL; + GenOp** last_op_next = NULL; + int arity; + + code = stp->code; + code_buffer_size = stp->code_buffer_size; + ci = stp->ci; + + for (;;) { + int new_op; + GenOp* tmp_op; + + ASSERT(ci <= code_buffer_size); + + get_next_instr: + GetByte(stp, new_op); + if (new_op >= NUM_GENERIC_OPS) { + LoadError1(stp, "invalid opcode %d", new_op); + } + if (gen_opc[new_op].name[0] == '\0') { + LoadError1(stp, "invalid opcode %d", new_op); + } + + + /* + * Create a new generic operation and put it last in the chain. + */ + if (last_op_next == NULL) { + last_op_next = &(stp->genop); + while (*last_op_next != NULL) { + last_op_next = &(*last_op_next)->next; + } + } + + NEW_GENOP(stp, last_op); + last_op->next = NULL; + last_op->op = new_op; + *last_op_next = last_op; + last_op_next = &(last_op->next); + stp->specific_op = -1; + + /* + * Read all arguments for the current operation. + */ + + arity = gen_opc[last_op->op].arity; + last_op->arity = 0; + ASSERT(arity <= MAX_OPARGS); + +#define GetValue(Stp, First, Val) \ + do { \ + if (((First) & 0x08) == 0) { \ + Val = (First) >> 4; \ + } else if (((First) & 0x10) == 0) { \ + Uint __w; \ + GetByte(Stp, __w); \ + Val = (((First) >> 5) << 8) | __w; \ + } else { \ + if (!get_int_val(Stp, (First), &(Val))) goto load_error; \ + } \ + } while (0) + + for (arg = 0; arg < arity; arg++) { + Uint first; + + GetByte(stp, first); + last_op->a[arg].type = first & 0x07; + switch (last_op->a[arg].type) { + case TAG_i: + if ((first & 0x08) == 0) { + last_op->a[arg].val = first >> 4; + } else if ((first & 0x10) == 0) { + Uint w; + GetByte(stp, w); + ASSERT(first < 0x800); + last_op->a[arg].val = ((first >> 5) << 8) | w; + } else { + int i = get_erlang_integer(stp, first, &(last_op->a[arg].val)); + if (i < 0) { + goto load_error; + } + last_op->a[arg].type = i; + } + break; + case TAG_u: + GetValue(stp, first, last_op->a[arg].val); + break; + case TAG_x: + GetValue(stp, first, last_op->a[arg].val); + if (last_op->a[arg].val == 0) { + last_op->a[arg].type = TAG_r; + } else if (last_op->a[arg].val >= MAX_REG) { + LoadError1(stp, "invalid x register number: %u", + last_op->a[arg].val); + } + break; + case TAG_y: + GetValue(stp, first, last_op->a[arg].val); + if (last_op->a[arg].val >= MAX_REG) { + LoadError1(stp, "invalid y register number: %u", + last_op->a[arg].val); + } + last_op->a[arg].val += CP_SIZE; + break; + case TAG_a: + GetValue(stp, first, last_op->a[arg].val); + if (last_op->a[arg].val == 0) { + last_op->a[arg].type = TAG_n; + } else if (last_op->a[arg].val >= stp->num_atoms) { + LoadError1(stp, "bad atom index: %d", last_op->a[arg].val); + } else { + last_op->a[arg].val = stp->atom[last_op->a[arg].val]; + } + break; + case TAG_f: + GetValue(stp, first, last_op->a[arg].val); + if (last_op->a[arg].val == 0) { + last_op->a[arg].type = TAG_p; + } else if (last_op->a[arg].val >= stp->num_labels) { + LoadError1(stp, "bad label: %d", last_op->a[arg].val); + } + break; + case TAG_h: + GetValue(stp, first, last_op->a[arg].val); + if (last_op->a[arg].val > 65535) { + LoadError1(stp, "invalid range for character data type: %u", + last_op->a[arg].val); + } + break; + case TAG_z: + { + Uint ext_tag; + unsigned tag; + + GetValue(stp, first, ext_tag); + switch (ext_tag) { + case 0: /* Floating point number */ + { + Eterm* hp; +# ifndef ARCH_64 + Uint high, low; +# endif + last_op->a[arg].val = new_literal(stp, &hp, + FLOAT_SIZE_OBJECT); + hp[0] = HEADER_FLONUM; + last_op->a[arg].type = TAG_q; +# ifdef ARCH_64 + GetInt(stp, 8, hp[1]); +# else + GetInt(stp, 4, high); + GetInt(stp, 4, low); + if (must_swap_floats) { + Uint t = high; + high = low; + low = t; + } + hp[1] = high; + hp[2] = low; +# endif + } + break; + case 1: /* List. */ + if (arg+1 != arity) { + LoadError0(stp, "list argument must be the last argument"); + } + GetTagAndValue(stp, tag, last_op->a[arg].val); + VerifyTag(stp, tag, TAG_u); + last_op->a[arg].type = TAG_u; + last_op->a = + erts_alloc(ERTS_ALC_T_LOADER_TMP, + (arity+last_op->a[arg].val) + *sizeof(GenOpArg)); + memcpy(last_op->a, last_op->def_args, + arity*sizeof(GenOpArg)); + arity += last_op->a[arg].val; + break; + case 2: /* Float register. */ + GetTagAndValue(stp, tag, last_op->a[arg].val); + VerifyTag(stp, tag, TAG_u); + last_op->a[arg].type = TAG_l; + break; + case 3: /* Allocation list. */ + { + Uint n; + Uint type; + Uint val; + Uint words = 0; + + stp->new_float_instructions = 1; + GetTagAndValue(stp, tag, n); + VerifyTag(stp, tag, TAG_u); + while (n-- > 0) { + GetTagAndValue(stp, tag, type); + VerifyTag(stp, tag, TAG_u); + GetTagAndValue(stp, tag, val); + VerifyTag(stp, tag, TAG_u); + switch (type) { + case 0: /* Heap words */ + words += val; + break; + case 1: + words += FLOAT_SIZE_OBJECT*val; + break; + default: + LoadError1(stp, "alloc list: bad allocation " + "descriptor %d", type); + break; + } + } + last_op->a[arg].type = TAG_u; + last_op->a[arg].val = words; + break; + } + case 4: /* Literal. */ + { + Uint val; + + GetTagAndValue(stp, tag, val); + VerifyTag(stp, tag, TAG_u); + if (val >= stp->num_literals) { + LoadError1(stp, "bad literal index %d", val); + } + last_op->a[arg].type = TAG_q; + last_op->a[arg].val = val; + break; + } + default: + LoadError1(stp, "invalid extended tag %d", ext_tag); + break; + } + } + break; + default: + LoadError1(stp, "bad tag %d", last_op->a[arg].type); + break; + } + last_op->arity++; + } +#undef GetValue + + ASSERT(arity == last_op->arity); + + do_transform: + if (stp->genop == NULL) { + last_op_next = NULL; + goto get_next_instr; + } + + if (gen_opc[stp->genop->op].transform != -1) { + int need; + tmp_op = stp->genop; + + for (need = gen_opc[stp->genop->op].min_window-1; need > 0; need--) { + if (tmp_op == NULL) { + goto get_next_instr; + } + tmp_op = tmp_op->next; + } + switch (transform_engine(stp)) { + case TE_FAIL: + last_op_next = NULL; + last_op = NULL; + break; + case TE_OK: + last_op_next = NULL; + last_op = NULL; + goto do_transform; + case TE_SHORT_WINDOW: + last_op_next = NULL; + last_op = NULL; + goto get_next_instr; + } + } + + if (stp->genop == NULL) { + last_op_next = NULL; + goto get_next_instr; + } + + /* + * Special error message instruction. + */ + if (stp->genop->op == genop_too_old_compiler_0) { + LoadError0(stp, "please re-compile this module with an " + ERLANG_OTP_RELEASE " compiler"); + } + + /* + * From the collected generic instruction, find the specific + * instruction. + */ + + { + Uint32 mask[3] = {0, 0, 0}; + + tmp_op = stp->genop; + arity = gen_opc[tmp_op->op].arity; + if (arity > 6) { + LoadError0(stp, "no specific operation found (arity > 6)"); + } + for (arg = 0; arg < arity; arg++) { + mask[arg/2] |= ((Uint32)1 << (tmp_op->a[arg].type)) << ((arg%2)*16); + } + specific = gen_opc[tmp_op->op].specific; + num_specific = gen_opc[tmp_op->op].num_specific; + for (i = 0; i < num_specific; i++) { + if (((opc[specific].mask[0] & mask[0]) == mask[0]) && + ((opc[specific].mask[1] & mask[1]) == mask[1]) && + ((opc[specific].mask[2] & mask[2]) == mask[2])) { + break; + } + specific++; + } + + /* + * No specific operation found. + */ + if (i == num_specific) { + stp->specific_op = -1; + for (arg = 0; arg < tmp_op->arity; arg++) { + /* + * We'll give the error message here (instead of earlier) + * to get a printout of the offending operation. + */ + if (tmp_op->a[arg].type == TAG_h) { + LoadError0(stp, "the character data type not supported"); + } + } + + /* + * No specific operations and no transformations means that + * the instruction is obsolete. + */ + if (num_specific == 0 && gen_opc[tmp_op->op].transform == -1) { + LoadError0(stp, "please re-compile this module with an " + ERLANG_OTP_RELEASE " compiler "); + } + + LoadError0(stp, "no specific operation found"); + } + + stp->specific_op = specific; + Need(opc[stp->specific_op].sz+2); /* Extra margin for packing */ + code[ci++] = BeamOpCode(stp->specific_op); + } + + /* + * Load the found specific operation. + */ + + sign = opc[stp->specific_op].sign; + ASSERT(sign != NULL); + arg = 0; + while (*sign) { + Uint tag; + + ASSERT(arg < stp->genop->arity); + tag = stp->genop->a[arg].type; + switch (*sign) { + case 'r': /* x(0) */ + case 'n': /* Nil */ + VerifyTag(stp, tag_to_letter[tag], *sign); + break; + case 'x': /* x(N) */ + case 'y': /* y(N) */ + VerifyTag(stp, tag_to_letter[tag], *sign); + code[ci++] = tmp_op->a[arg].val * sizeof(Eterm); + break; + case 'a': /* Tagged atom */ + VerifyTag(stp, tag_to_letter[tag], *sign); + code[ci++] = tmp_op->a[arg].val; + break; + case 'i': /* Tagged integer */ + ASSERT(is_small(tmp_op->a[arg].val)); + VerifyTag(stp, tag_to_letter[tag], *sign); + code[ci++] = tmp_op->a[arg].val; + break; + case 'c': /* Tagged constant */ + switch (tag) { + case TAG_i: + code[ci++] = make_small(tmp_op->a[arg].val); + break; + case TAG_a: + code[ci++] = tmp_op->a[arg].val; + break; + case TAG_n: + code[ci++] = NIL; + break; + case TAG_q: + new_literal_patch(stp, ci); + code[ci++] = tmp_op->a[arg].val; + break; + default: + LoadError1(stp, "bad tag %d for tagged constant", + tmp_op->a[arg].type); + break; + } + break; + case 's': /* Any source (tagged constant or register) */ + switch (tag) { + case TAG_r: + code[ci++] = make_rreg(); + break; + case TAG_x: + code[ci++] = make_xreg(tmp_op->a[arg].val); + break; + case TAG_y: + code[ci++] = make_yreg(tmp_op->a[arg].val); + break; + case TAG_i: + code[ci++] = make_small(tmp_op->a[arg].val); + break; + case TAG_a: + code[ci++] = tmp_op->a[arg].val; + break; + case TAG_n: + code[ci++] = NIL; + break; + default: + LoadError1(stp, "bad tag %d for general source", + tmp_op->a[arg].type); + break; + } + break; + case 'd': /* Destination (x(0), x(N), y(N) */ + switch (tag) { + case TAG_r: + code[ci++] = make_rreg(); + break; + case TAG_x: + code[ci++] = make_xreg(tmp_op->a[arg].val); + break; + case TAG_y: + code[ci++] = make_yreg(tmp_op->a[arg].val); + break; + default: + LoadError1(stp, "bad tag %d for destination", + tmp_op->a[arg].type); + break; + } + break; + case 'I': /* Untagged integer (or pointer). */ + VerifyTag(stp, tag, TAG_u); + code[ci++] = tmp_op->a[arg].val; + break; + case 't': /* Small untagged integer -- can be packed. */ + VerifyTag(stp, tag, TAG_u); + code[ci++] = tmp_op->a[arg].val; + break; + case 'A': /* Arity value. */ + VerifyTag(stp, tag, TAG_u); + code[ci++] = make_arityval(tmp_op->a[arg].val); + break; + case 'f': /* Destination label */ + VerifyTag(stp, tag_to_letter[tag], *sign); + code[ci] = stp->labels[tmp_op->a[arg].val].patches; + stp->labels[tmp_op->a[arg].val].patches = ci; + ci++; + break; + case 'j': /* 'f' or 'p' */ + if (tag == TAG_p) { + code[ci] = 0; + } else if (tag == TAG_f) { + code[ci] = stp->labels[tmp_op->a[arg].val].patches; + stp->labels[tmp_op->a[arg].val].patches = ci; + } else { + LoadError3(stp, "bad tag %d; expected %d or %d", + tag, TAG_f, TAG_p); + } + ci++; + break; + case 'L': /* Define label */ + ci--; /* Remove label from loaded code */ + ASSERT(stp->specific_op == op_label_L); + VerifyTag(stp, tag, TAG_u); + last_label = tmp_op->a[arg].val; + if (!(0 < last_label && last_label < stp->num_labels)) { + LoadError2(stp, "invalid label num %d (0 < label < %d)", + tmp_op->a[arg].val, stp->num_labels); + } + if (stp->labels[last_label].value != 0) { + LoadError1(stp, "label %d defined more than once", last_label); + } + stp->labels[last_label].value = ci; + ASSERT(stp->labels[last_label].patches < ci); + break; + case 'e': /* Export entry */ + VerifyTag(stp, tag, TAG_u); + if (tmp_op->a[arg].val >= stp->num_imports) { + LoadError1(stp, "invalid import table index %d", tmp_op->a[arg].val); + } + code[ci] = stp->import[tmp_op->a[arg].val].patches; + stp->import[tmp_op->a[arg].val].patches = ci; + ci++; + break; + case 'b': + VerifyTag(stp, tag, TAG_u); + i = tmp_op->a[arg].val; + if (i >= stp->num_imports) { + LoadError1(stp, "invalid import table index %d", i); + } + if (stp->import[i].bf == NULL) { + LoadError1(stp, "not a BIF: import table index %d", i); + } + code[ci++] = (Eterm) stp->import[i].bf; + break; + case 'P': /* Byte offset into tuple */ + VerifyTag(stp, tag, TAG_u); + tmp = tmp_op->a[arg].val; + code[ci++] = (Eterm) ((tmp_op->a[arg].val+1) * sizeof(Eterm *)); + break; + case 'l': /* Floating point register. */ + VerifyTag(stp, tag_to_letter[tag], *sign); + code[ci++] = tmp_op->a[arg].val * sizeof(FloatDef); + break; + case 'q': /* Literal */ + new_literal_patch(stp, ci); + code[ci++] = tmp_op->a[arg].val; + break; + default: + LoadError1(stp, "bad argument tag: %d", *sign); + } + sign++; + arg++; + } + + /* + * Load any list arguments using the primitive tags. + */ + + for ( ; arg < tmp_op->arity; arg++) { + switch (tmp_op->a[arg].type) { + case TAG_i: + Need(1); + code[ci++] = make_small(tmp_op->a[arg].val); + break; + case TAG_u: + case TAG_a: + case TAG_v: + Need(1); + code[ci++] = tmp_op->a[arg].val; + break; + case TAG_f: + Need(1); + code[ci] = stp->labels[tmp_op->a[arg].val].patches; + stp->labels[tmp_op->a[arg].val].patches = ci; + ci++; + break; + case TAG_q: + { + Eterm lit; + + lit = stp->literals[tmp_op->a[arg].val].term; + if (is_big(lit)) { + Eterm* bigp; + Uint size; + + bigp = big_val(lit); + size = bignum_header_arity(*bigp); + Need(size+1); + code[ci++] = *bigp++; + while (size-- > 0) { + code[ci++] = *bigp++; + } + } else if (is_float(lit)) { +#ifdef ARCH_64 + Need(1); + code[ci++] = float_val(stp->literals[tmp_op->a[arg].val].term)[1]; +#else + Eterm* fptr; + + fptr = float_val(stp->literals[tmp_op->a[arg].val].term)+1; + Need(2); + code[ci++] = *fptr++; + code[ci++] = *fptr; +#endif + } else { + LoadError0(stp, "literal is neither float nor big"); + } + } + break; + default: + LoadError1(stp, "unsupported primitive type '%c'", + tag_to_letter[tmp_op->a[arg].type]); + } + } + + /* + * The packing engine. + */ + if (opc[stp->specific_op].pack[0]) { + char* prog; /* Program for packing engine. */ + Uint stack[8]; /* Stack. */ + Uint* sp = stack; /* Points to next free position. */ + Uint packed = 0; /* Accumulator for packed operations. */ + + for (prog = opc[stp->specific_op].pack; *prog; prog++) { + switch (*prog) { + case 'g': /* Get instruction; push on stack. */ + *sp++ = code[--ci]; + break; + case 'i': /* Initialize packing accumulator. */ + packed = code[--ci]; + break; + case '0': /* Tight shift */ + packed = (packed << BEAM_TIGHT_SHIFT) | code[--ci]; + break; + case '6': /* Shift 16 steps */ + packed = (packed << 16) | code[--ci]; + break; + case 'p': /* Put instruction (from stack). */ + code[ci++] = *--sp; + break; + case 'P': /* Put packed operands. */ + *sp++ = packed; + packed = 0; + break; + default: + ASSERT(0); + } + } + ASSERT(sp == stack); /* Incorrect program? */ + } + + /* + * Handle a few special cases. + */ + switch (stp->specific_op) { + case op_i_func_info_IaaI: + { + Uint offset; + enum { FINFO_SZ = 5 }; + + if (function_number >= stp->num_functions) { + LoadError1(stp, "too many functions in module (header said %d)", + stp->num_functions); + } + + if (stp->may_load_nif) { + const int finfo_ix = ci - FINFO_SZ; + enum { MIN_FUNC_SZ = 3 }; + if (finfo_ix - last_func_start < MIN_FUNC_SZ && last_func_start) { + /* Must make room for call_nif op */ + int pad = MIN_FUNC_SZ - (finfo_ix - last_func_start); + ASSERT(pad > 0 && pad < MIN_FUNC_SZ); + Need(pad); + sys_memmove(&code[finfo_ix+pad], &code[finfo_ix], FINFO_SZ*sizeof(Eterm)); + sys_memset(&code[finfo_ix], 0, pad*sizeof(Eterm)); + ci += pad; + stp->labels[last_label].value += pad; + } + } + last_func_start = ci; + /* + * Save context for error messages. + */ + stp->function = code[ci-2]; + stp->arity = code[ci-1]; + ASSERT(stp->labels[last_label].value == ci - FINFO_SZ); + offset = MI_FUNCTIONS + function_number; + code[offset] = stp->labels[last_label].patches; + stp->labels[last_label].patches = offset; + function_number++; + if (stp->arity > MAX_ARG) { + LoadError1(stp, "too many arguments: %d", stp->arity); + } +#ifdef DEBUG + ASSERT(stp->labels[0].patches == 0); /* Should not be referenced. */ + for (i = 1; i < stp->num_labels; i++) { + ASSERT(stp->labels[i].patches < ci); + } +#endif + } + break; + case op_on_load: + ci--; /* Get rid of the instruction */ + + /* Remember offset for the on_load function. */ + stp->on_load = ci; + break; + case op_put_string_IId: + { + /* + * At entry: + * + * code[ci-4] &&lb_put_string_IId + * code[ci-3] length of string + * code[ci-2] offset into string table + * code[ci-1] destination register + * + * Since we don't know the address of the string table yet, + * just check the offset and length for validity, and use + * the instruction field as a link field to link all put_string + * instructions into a single linked list. At exit: + * + * code[ci-4] pointer to next put_string instruction (or 0 + * if this is the last) + */ + Uint offset = code[ci-2]; + Uint len = code[ci-3]; + unsigned strtab_size = stp->chunks[STR_CHUNK].size; + if (offset > strtab_size || offset + len > strtab_size) { + LoadError2(stp, "invalid string reference %d, size %d", offset, len); + } + code[ci-4] = stp->put_strings; + stp->put_strings = ci - 4; + } + break; + case op_bs_put_string_II: + { + /* + * At entry: + * + * code[ci-3] &&lb_i_new_bs_put_string_II + * code[ci-2] length of string + * code[ci-1] offset into string table + * + * Since we don't know the address of the string table yet, + * just check the offset and length for validity, and use + * the instruction field as a link field to link all put_string + * instructions into a single linked list. At exit: + * + * code[ci-3] pointer to next i_new_bs_put_string instruction (or 0 + * if this is the last) + */ + Uint offset = code[ci-1]; + Uint len = code[ci-2]; + unsigned strtab_size = stp->chunks[STR_CHUNK].size; + if (offset > strtab_size || offset + len > strtab_size) { + LoadError2(stp, "invalid string reference %d, size %d", offset, len); + } + code[ci-3] = stp->new_bs_put_strings; + stp->new_bs_put_strings = ci - 3; + } + break; + case op_i_bs_match_string_rfII: + case op_i_bs_match_string_xfII: + new_string_patch(stp, ci-1); + break; + + case op_catch_yf: + /* code[ci-3] &&lb_catch_yf + * code[ci-2] y-register offset in E + * code[ci-1] label; index tagged as CATCH at runtime + */ + code[ci-3] = stp->catches; + stp->catches = ci-3; + break; + + /* + * End of code found. + */ + case op_int_code_end: + stp->code_buffer_size = code_buffer_size; + stp->ci = ci; + return 1; + } + + /* + * Delete the generic instruction just loaded. + */ + { + GenOp* next = stp->genop->next; + FREE_GENOP(stp, stp->genop); + stp->genop = next; + goto do_transform; + } + } + +#undef Need + + load_error: + return 0; +} + + +#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) + +#ifdef NO_FPE_SIGNALS +#define no_fpe_signals(St) 1 +#else +#define no_fpe_signals(St) 0 +#endif + +/* + * Predicate that tests whether a jump table can be used. + */ + +static int +use_jump_tab(LoaderState* stp, GenOpArg Size, GenOpArg* Rest) +{ + Sint min, max; + Sint i; + + if (Size.val < 2 || Size.val % 2 != 0) { + return 0; + } + + /* 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; + } + } + + return max - min <= Size.val; +} + +/* + * Predicate to test whether all values in a table are big numbers. + */ + +static int +all_values_are_big(LoaderState* stp, GenOpArg Size, GenOpArg* 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 (is_not_big(stp->literals[Rest[i].val].term)) { + return 0; + } + if (Rest[i+1].type != TAG_f) { + return 0; + } + } + + return 1; +} + + +/* + * Predicate to test whether all values in a table have a fixed size. + */ + +static int +fixed_size_values(LoaderState* stp, GenOpArg Size, GenOpArg* 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(stp->literals[Rest[i].val].term); + default: + return 0; + } + } + + 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; + } + + type = Rest[0].type; + for (i = 0; i < Size.val; i += 2) { + if (Rest[i].type != type) + return 1; + } + + 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->op = genop_i_element_4; + op->arity = 4; + op->a[0] = Fail; + op->a[1] = Index; + op->a[2] = Tuple; + op->a[3] = Dst; + op->next = NULL; + + /* + * If safe, generate a faster instruction. + */ + + if (Index.type == TAG_i && Index.val > 0 && + (Tuple.type == TAG_r || Tuple.type == TAG_x || Tuple.type == TAG_y)) { + op->op = genop_i_fast_element_4; + op->a[1].type = TAG_u; + op->a[1].val = Index.val; + } + + return op; +} + +static GenOp* +gen_bs_save(LoaderState* stp, GenOpArg Reg, GenOpArg Index) +{ + GenOp* op; + + NEW_GENOP(stp, op); + op->op = genop_i_bs_save2_2; + op->arity = 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); + op->op = genop_i_bs_restore2_2; + op->arity = 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; + Uint 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) { + op->op = genop_i_bs_get_integer_8_3; + op->arity = 3; + op->a[0] = Ms; + op->a[1] = Fail; + op->a[2] = Dst; + } else if (bits == 16 && (Flags.val & BSF_LITTLE) == 0) { + op->op = genop_i_bs_get_integer_16_3; + op->arity = 3; + op->a[0] = Ms; + op->a[1] = Fail; + op->a[2] = Dst; + } else if (bits == 32 && (Flags.val & BSF_LITTLE) == 0) { + op->op = genop_i_bs_get_integer_32_4; + op->arity = 4; + op->a[0] = Ms; + op->a[1] = Fail; + op->a[2] = Live; + op->a[3] = Dst; + } else { + generic: + if (bits < SMALL_BITS) { + op->op = genop_i_bs_get_integer_small_imm_5; + op->arity = 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 { + op->op = genop_i_bs_get_integer_imm_6; + op->arity = 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: + op->op = genop_jump_1; + op->arity = 1; + op->a[0] = Fail; + } else { + if (!safe_mul(bigval, Unit.val, &bits)) { + goto error; + } + goto generic; + } + } else { + GenOp* op2; + NEW_GENOP(stp, op2); + + op->op = genop_i_fetch_2; + op->arity = 2; + op->a[0] = Ms; + op->a[1] = Size; + op->next = op2; + + op2->op = genop_i_bs_get_integer_4; + op2->arity = 4; + op2->a[0] = Fail; + op2->a[1] = Live; + op2->a[2].type = TAG_u; + op2->a[2].val = (Unit.val << 3) | Flags.val; + op2->a[3] = Dst; + op2->next = NULL; + return op; + } + 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) { + if (Ms.type == Dst.type && Ms.val == Dst.val) { + op->op = genop_i_bs_get_binary_all_reuse_3; + op->arity = 3; + op->a[0] = Ms; + op->a[1] = Fail; + op->a[2] = Unit; + } else { + op->op = genop_i_bs_get_binary_all2_5; + op->arity = 5; + op->a[0] = Fail; + op->a[1] = Ms; + op->a[2] = Live; + op->a[3] = Unit; + op->a[4] = Dst; + } + } else if (Size.type == TAG_i) { + op->op = genop_i_bs_get_binary_imm2_6; + op->arity = 6; + op->a[0] = Fail; + op->a[1] = Ms; + 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: + op->op = genop_jump_1; + op->arity = 1; + op->a[0] = Fail; + } else { + op->op = genop_i_bs_get_binary_imm2_6; + op->arity = 6; + op->a[0] = Fail; + op->a[1] = Ms; + 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 { + op->op = genop_i_bs_get_binary2_6; + op->arity = 6; + op->a[0] = Fail; + op->a[1] = Ms; + 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; +} + +/* + * Predicate to test whether a heap binary should be generated. + */ + +static int +should_gen_heap_bin(LoaderState* stp, GenOpArg Src) +{ + return Src.val <= ERL_ONHEAP_BIN_LIMIT; +} + +/* + * Predicate to test whether a binary construction is too big. + */ + +static int +binary_too_big(LoaderState* stp, GenOpArg Size) +{ + return Size.type == TAG_u && ((Size.val >> (8*sizeof(Uint)-3)) != 0); +} + +static int +binary_too_big_bits(LoaderState* stp, GenOpArg Size) +{ + return Size.type == TAG_u && (((Size.val+7)/8) >> (8*sizeof(Uint)-3) != 0); +} + +#define new_float_allocation(Stp) ((Stp)->new_float_instructions) + +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) { + op->op = genop_i_new_bs_put_binary_all_3; + op->arity = 3; + op->a[0] = Fail; + op->a[1] = Src; + op->a[2] = Unit; + } else if (Size.type == TAG_i) { + op->op = genop_i_new_bs_put_binary_imm_3; + op->arity = 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 { + op->op = genop_badarg_1; + op->arity = 1; + op->a[0] = Fail; + } + } else { + op->op = genop_i_new_bs_put_binary_4; + op->arity = 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); + if (Size.type == TAG_i && Size.val < 0) { + error: + /* Negative size must fail */ + op->op = genop_badarg_1; + op->arity = 1; + op->a[0] = Fail; + } else if (Size.type == TAG_i) { + op->op = genop_i_new_bs_put_integer_imm_4; + op->arity = 4; + op->a[0] = Fail; + op->a[1].type = TAG_u; + if (!safe_mul(Size.val, Unit.val, &op->a[1].val)) { + goto error; + } + op->a[1].val = Size.val * Unit.val; + op->a[2].type = Flags.type; + op->a[2].val = (Flags.val & 7); + op->a[3] = Src; + } else if (Size.type == TAG_q) { + Eterm big = stp->literals[Size.val].term; + Uint bigval; + + if (!term_to_Uint(big, &bigval)) { + goto error; + } else { + op->op = genop_i_new_bs_put_integer_imm_4; + op->arity = 4; + op->a[0] = Fail; + op->a[1].type = TAG_u; + op->a[1].val = bigval * Unit.val; + op->a[2].type = Flags.type; + op->a[2].val = (Flags.val & 7); + op->a[3] = Src; + } + } else { + op->op = genop_i_new_bs_put_integer_4; + op->arity = 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) { + op->op = genop_i_new_bs_put_float_imm_4; + op->arity = 4; + op->a[0] = Fail; + op->a[1].type = TAG_u; + if (!safe_mul(Size.val, Unit.val, &op->a[1].val)) { + op->op = genop_badarg_1; + op->arity = 1; + op->a[0] = Fail; + } else { + op->a[2] = Flags; + op->a[3] = Src; + } + } else { + op->op = genop_i_new_bs_put_float_4; + op->arity = 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); + op->op = genop_i_bs_get_float2_6; + op->arity = 6; + op->a[0] = Fail; + op->a[1] = Ms; + 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) { + op->op = genop_i_bs_skip_bits_all2_3; + op->arity = 3; + op->a[0] = Fail; + op->a[1] = Ms; + op->a[2] = Unit; + } else if (Size.type == TAG_i) { + op->op = genop_i_bs_skip_bits_imm2_3; + op->arity = 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: + op->op = genop_jump_1; + op->arity = 1; + op->a[0] = Fail; + } else { + op->op = genop_i_bs_skip_bits_imm2_3; + op->arity = 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 { + op->op = genop_i_bs_skip_bits2_4; + op->arity = 4; + op->a[0] = Fail; + op->a[1] = Ms; + op->a[2] = Size; + op->a[3] = Unit; + } + op->next = NULL; + return op; +} + +static int +smp(LoaderState* stp) +{ +#ifdef ERTS_SMP + return 1; +#else + return 0; +#endif +} + +/* + * Mark this label. + */ +static int +smp_mark_target_label(LoaderState* stp, GenOpArg L) +{ +#ifdef ERTS_SMP + ASSERT(L.type == TAG_f); + stp->labels[L.val].looprec_targeted = 1; +#endif + return 1; +} + +/* + * Test whether this label was targeted by a loop_rec/2 instruction. + */ + +static int +smp_already_locked(LoaderState* stp, GenOpArg L) +{ +#ifdef ERTS_SMP + ASSERT(L.type == TAG_u); + return stp->labels[L.val].looprec_targeted; +#else + return 0; +#endif +} + +/* + * 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); + op->op = genop_i_wait_timeout_2; + op->next = NULL; + op->arity = 2; + op->a[0] = Fail; + op->a[1].type = TAG_u; + + if (Time.type == TAG_i && (timeout = Time.val) >= 0 && +#ifdef ARCH_64 + (timeout >> 32) == 0 +#else + 1 +#endif + ) { + op->a[1].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 { + (void) term_to_Uint(big, &op->a[1].val); + } +#endif + } else { +#if !defined(ARCH_64) + error: +#endif + op->op = genop_i_wait_error_0; + op->arity = 0; + } + return op; +} + +static GenOp* +gen_literal_timeout_locked(LoaderState* stp, GenOpArg Fail, GenOpArg Time) +{ + GenOp* op; + Sint timeout; + + NEW_GENOP(stp, op); + op->op = genop_i_wait_timeout_locked_2; + op->next = NULL; + op->arity = 2; + op->a[0] = Fail; + op->a[1].type = TAG_u; + + if (Time.type == TAG_i && (timeout = Time.val) >= 0 && +#ifdef ARCH_64 + (timeout >> 32) == 0 +#else + 1 +#endif + ) { + op->a[1].val = timeout; +#ifndef 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 { + (void) term_to_Uint(big, &op->a[1].val); + } +#endif + } else { +#ifndef ARCH_64 + error: +#endif + op->op = genop_i_wait_error_locked_0; + op->arity = 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; + int arity = Size.val + 3; + int size = Size.val / 2; + int i; + + /* + * 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; + } + } + + /* + * Generate the generic instruction. + */ + + NEW_GENOP(stp, op); + op->next = NULL; + op->op = genop_i_select_tuple_arity_3; + GENOP_ARITY(op, arity); + op->a[0] = S; + op->a[1] = Fail; + op->a[2].type = TAG_u; + op->a[2].val = Size.val / 2; + for (i = 0; i < Size.val; i += 2) { + op->a[i+3].type = TAG_v; + op->a[i+3].val = make_arityval(Rest[i].val); + op->a[i+4] = Rest[i+1]; + } + + /* + * Sort the values to make them useful for a binary search. + */ + + qsort(op->a+3, size, 2*sizeof(GenOpArg), + (int (*)(const void *, const void *)) genopargcompare); +#ifdef DEBUG + for (i = 3; i < arity-2; i += 2) { + ASSERT(op->a[i].val < op->a[i+2].val); + } +#endif + 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 Fail, + GenOpArg Size, GenOpArg* Rest) + +{ + GenOp* op1; + GenOp* op2; + GenOp* label; + Uint type; + int i; + + ASSERT(Size.val >= 2 && Size.val % 2 == 0); + + NEW_GENOP(stp, label); + label->op = genop_label_1; + label->arity = 1; + label->a[0].type = TAG_u; + label->a[0].val = new_label(stp); + + NEW_GENOP(stp, op1); + op1->op = genop_select_val_3; + GENOP_ARITY(op1, 3 + Size.val); + op1->arity = 3; + 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); + op2->op = genop_select_val_3; + GENOP_ARITY(op2, 3 + Size.val); + op2->arity = 3; + op2->a[0] = S; + op2->a[1] = Fail; + op2->a[2].type = TAG_u; + op2->a[2].val = 0; + + op1->next = label; + label->next = op2; + op2->next = NULL; + + type = Rest[0].type; + + ASSERT(Size.type == TAG_u); + for (i = 0; i < Size.val; i += 2) { + GenOp* op = (Rest[i].type == type) ? op1 : op2; + 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; + } + + /* + * None of the instructions should have zero elements in the list. + */ + + ASSERT(op1->a[2].val > 0); + ASSERT(op2->a[2].val > 0); + + 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); + + /* + * 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) { + op->op = genop_i_jump_on_val_zero_3; + fixed_args = 3; + } else { + op->op = genop_i_jump_on_val_4; + fixed_args = 4; + } + 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) { + int 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, atoms, floats; never bignums). + */ + +static GenOp* +gen_select_val(LoaderState* stp, GenOpArg S, GenOpArg Fail, + GenOpArg Size, GenOpArg* Rest) +{ + GenOp* op; + int arity = Size.val + 3; + int size = Size.val / 2; + int i; + + NEW_GENOP(stp, op); + op->next = NULL; + if (Rest[0].type != TAG_q) { + op->op = genop_i_select_val_3; + } else { + ASSERT(is_float(stp->literals[Rest[0].val].term)); + op->op = genop_i_select_float_3; + } + GENOP_ARITY(op, arity); + op->a[0] = S; + op->a[1] = Fail; + op->a[2].type = TAG_u; + op->a[2].val = size; + for (i = 3; i < arity; i++) { + op->a[i] = Rest[i-3]; + } + + /* + * Sort the values to make them useful for a binary search. + */ + + qsort(op->a+3, size, 2*sizeof(GenOpArg), + (int (*)(const void *, const void *)) genopargcompare); +#ifdef DEBUG + for (i = 3; i < arity-2; i += 2) { + ASSERT(op->a[i].val < op->a[i+2].val); + } +#endif + + return op; +} + +/* + * Compare function for qsort(). + */ + +static int +genbigcompare(GenOpArg* a, GenOpArg* b) +{ + int val = (int)(b->bigarity - a->bigarity); + + return val != 0 ? val : ((int) (a->val - b->val)); +} + +/* + * Generate a select_val instruction for big numbers. + */ + +static GenOp* +gen_select_big(LoaderState* stp, GenOpArg S, GenOpArg Fail, + GenOpArg Size, GenOpArg* Rest) +{ + GenOp* op; + int arity = Size.val + 2 + 1; + int size = Size.val / 2; + int i; + + NEW_GENOP(stp, op); + op->next = NULL; + op->op = genop_i_select_big_2; + GENOP_ARITY(op, arity); + op->a[0] = S; + op->a[1] = Fail; + for (i = 0; i < Size.val; i += 2) { + ASSERT(Rest[i].type == TAG_q); + op->a[i+2] = Rest[i]; + op->a[i+2].bigarity = *big_val(stp->literals[op->a[i+2].val].term); + op->a[i+3] = Rest[i+1]; + } + ASSERT(i+2 == arity-1); + op->a[arity-1].type = TAG_u; + op->a[arity-1].val = 0; + + /* + * Sort the values in descending arity order. + */ + + qsort(op->a+2, size, 2*sizeof(GenOpArg), + (int (*)(const void *, const void *)) genbigcompare); + + 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); + ASSERT(S.type == TAG_q); + + NEW_GENOP(stp, op); + op->next = NULL; + op->op = genop_jump_1; + op->arity = 1; + + /* + * Search for a literal matching the controlling expression. + */ + + if (S.type == 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; + } + } + } + } + + /* + * No match. Use the failure label. + */ + + op->a[0] = Fail; + return op; +} + + +static GenOp* +gen_func_info(LoaderState* stp, GenOpArg mod, GenOpArg func, + GenOpArg arity, GenOpArg label) +{ + GenOp* fi; + GenOp* op; + + NEW_GENOP(stp, fi); + fi->op = genop_i_func_info_4; + fi->arity = 4; + fi->a[0].type = TAG_u; /* untagged Zero */ + fi->a[0].val = 0; + fi->a[1] = mod; + fi->a[2] = func; + fi->a[3] = arity; + + NEW_GENOP(stp, op); + op->op = genop_label_1; + op->arity = 1; + op->a[0] = label; + + fi->next = op; + op->next = NULL; + + return fi; +} + + + +static GenOp* +gen_make_fun2(LoaderState* stp, GenOpArg idx) +{ + ErlFunEntry* fe; + GenOp* op; + + if (idx.val >= stp->num_lambdas) { + stp->lambda_error = "missing or short chunk 'FunT'"; + fe = 0; + } else { + fe = stp->lambdas[idx.val].fe; + } + + NEW_GENOP(stp, op); + op->op = genop_i_make_fun_2; + op->arity = 2; + op->a[0].type = TAG_u; + op->a[0].val = (Uint) fe; + op->a[1].type = TAG_u; + op->a[1].val = stp->lambdas[idx.val].num_free; + op->next = NULL; + return op; +} + +static GenOp* +gen_guard_bif(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif, + GenOpArg Src, GenOpArg Dst) +{ + GenOp* op; + BifFunction bf; + + NEW_GENOP(stp, op); + op->op = genop_i_gc_bif1_5; + op->arity = 5; + op->a[0] = Fail; + op->a[1].type = TAG_u; + bf = stp->import[Bif.val].bf; + if (bf == length_1) { + op->a[1].val = (Uint) (void *) erts_gc_length_1; + } else if (bf == size_1) { + op->a[1].val = (Uint) (void *) erts_gc_size_1; + } else if (bf == bit_size_1) { + op->a[1].val = (Uint) (void *) erts_gc_bit_size_1; + } else if (bf == byte_size_1) { + op->a[1].val = (Uint) (void *) erts_gc_byte_size_1; + } else if (bf == abs_1) { + op->a[1].val = (Uint) (void *) erts_gc_abs_1; + } else if (bf == float_1) { + op->a[1].val = (Uint) (void *) erts_gc_float_1; + } else if (bf == round_1) { + op->a[1].val = (Uint) (void *) erts_gc_round_1; + } else if (bf == trunc_1) { + op->a[1].val = (Uint) (void *) erts_gc_trunc_1; + } else { + abort(); + } + op->a[2] = Src; + op->a[3] = Live; + op->a[4] = Dst; + op->next = NULL; + return op; +} + + +/* + * Freeze the code in memory, move the string table into place, + * resolve all labels. + */ + +static int +freeze_code(LoaderState* stp) +{ + Eterm* code = stp->code; + Uint index; + 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; + unsigned catches; + Sint decoded_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. + */ + + size = (stp->ci + stp->total_literal_size) * sizeof(Eterm) + + strtab_size + attr_size + compile_size; + + /* + * Move the code to its final location. + */ + + code = (Eterm *) erts_realloc(ERTS_ALC_T_CODE, (void *) code, size); + + /* + * Place a pointer to the op_int_code_end instruction in the + * function table in the beginning of the file. + */ + + code[MI_FUNCTIONS+stp->num_functions] = (Eterm) (code + stp->ci - 1); + + /* + * Store the pointer to the on_load function. + */ + + if (stp->on_load) { + code[MI_ON_LOAD_FUNCTION_PTR] = (Eterm) (code + stp->on_load); + } else { + code[MI_ON_LOAD_FUNCTION_PTR] = 0; + } + + /* + * Place the literal heap directly after the code and fix up all + * put_literal instructions that refer to it. + */ + { + Eterm* ptr; + Eterm* low; + Eterm* high; + LiteralPatch* lp; + + low = code+stp->ci; + high = low + stp->total_literal_size; + code[MI_LITERALS_START] = (Eterm) low; + code[MI_LITERALS_END] = (Eterm) high; + ptr = low; + for (i = 0; i < stp->num_literals; i++) { + Uint offset; + + sys_memcpy(ptr, stp->literals[i].heap, + stp->literals[i].heap_size*sizeof(Eterm)); + offset = ptr - stp->literals[i].heap; + stp->literals[i].offset = offset; + high = ptr + stp->literals[i].heap_size; + while (ptr < high) { + Eterm val = *ptr; + switch (primary_tag(val)) { + case TAG_PRIMARY_LIST: + case TAG_PRIMARY_BOXED: + *ptr++ = offset_ptr(val, offset); + break; + case TAG_PRIMARY_HEADER: + ptr++; + if (header_is_thing(val)) { + ptr += thing_arityval(val); + } + break; + default: + ptr++; + break; + } + } + ASSERT(ptr == high); + } + lp = stp->literal_patches; + while (lp != 0) { + Uint* op_ptr; + Uint literal; + Literal* lit; + + op_ptr = code + lp->pos; + lit = &stp->literals[op_ptr[0]]; + literal = lit->term; + if (is_boxed(literal) || is_list(literal)) { + literal = offset_ptr(literal, lit->offset); + } + op_ptr[0] = literal; + lp = lp->next; + } + stp->ci += stp->total_literal_size; + } + + /* + * Place the string table and, optionally, attributes, after the literal heap. + */ + + sys_memcpy(code+stp->ci, stp->chunks[STR_CHUNK].start, strtab_size); + str_table = (byte *) (code+stp->ci); + if (attr_size) { + byte* attr = str_table + strtab_size; + sys_memcpy(attr, stp->chunks[ATTR_CHUNK].start, stp->chunks[ATTR_CHUNK].size); + code[MI_ATTR_PTR] = (Eterm) attr; + code[MI_ATTR_SIZE] = (Eterm) stp->chunks[ATTR_CHUNK].size; + decoded_size = erts_decode_ext_size(attr, attr_size, 0); + if (decoded_size < 0) { + LoadError0(stp, "bad external term representation of module attributes"); + } + code[MI_ATTR_SIZE_ON_HEAP] = decoded_size; + } + if (compile_size) { + byte* compile_info = str_table + strtab_size + attr_size; + sys_memcpy(compile_info, stp->chunks[COMPILE_CHUNK].start, + stp->chunks[COMPILE_CHUNK].size); + code[MI_COMPILE_PTR] = (Eterm) compile_info; + code[MI_COMPILE_SIZE] = (Eterm) stp->chunks[COMPILE_CHUNK].size; + decoded_size = erts_decode_ext_size(compile_info, compile_size, 0); + if (decoded_size < 0) { + LoadError0(stp, "bad external term representation of compilation information"); + } + code[MI_COMPILE_SIZE_ON_HEAP] = decoded_size; + } + + + /* + * Go through all put_strings instructions, restore the pointer to + * the instruction and convert string offsets to pointers (to the + * LAST character). + */ + + index = stp->put_strings; + while (index != 0) { + Uint next = code[index]; + code[index] = BeamOpCode(op_put_string_IId); + code[index+2] = (Uint) (str_table + code[index+2] + code[index+1] - 1); + index = next; + } + + /* + * Go through all i_new_bs_put_strings instructions, restore the pointer to + * the instruction and convert string offsets to pointers (to the + * FIRST character). + */ + + index = stp->new_bs_put_strings; + while (index != 0) { + Uint next = code[index]; + code[index] = BeamOpCode(op_bs_put_string_II); + code[index+2] = (Uint) (str_table + code[index+2]); + index = next; + } + + { + StringPatch* sp = stp->string_patches; + + while (sp != 0) { + Uint* op_ptr; + byte* strp; + + op_ptr = code + sp->pos; + strp = str_table + op_ptr[0]; + op_ptr[0] = (Eterm) strp; + sp = sp->next; + } + } + + /* + * Resolve all labels. + */ + + for (i = 0; i < stp->num_labels; i++) { + Uint this_patch; + Uint next_patch; + Uint value = stp->labels[i].value; + + if (value == 0 && stp->labels[i].patches != 0) { + LoadError1(stp, "label %d not resolved", i); + } + ASSERT(value < stp->ci); + this_patch = stp->labels[i].patches; + while (this_patch != 0) { + ASSERT(this_patch < stp->ci); + next_patch = code[this_patch]; + ASSERT(next_patch < stp->ci); + code[this_patch] = (Uint) (code + value); + this_patch = next_patch; + } + } + + /* + * Fix all catch_yf instructions. + */ + index = stp->catches; + catches = BEAM_CATCHES_NIL; + while (index != 0) { + Uint next = code[index]; + code[index] = BeamOpCode(op_catch_yf); + catches = beam_catches_cons((Uint*)code[index+2], catches); + code[index+2] = make_catch(catches); + index = next; + } + stp->catches = catches; + + /* + * Save the updated code pointer and code size. + */ + + stp->code = code; + stp->loaded_size = size; + + return 1; + + load_error: + /* + * Make sure that the caller frees the newly reallocated block, and + * not the old one (in case it has moved). + */ + stp->code = code; + return 0; +} + + +static void +final_touch(LoaderState* stp) +{ + int i; + int on_load = stp->on_load; + + /* + * Export functions. + */ + + for (i = 0; i < stp->num_exps; i++) { + Export* ep = erts_export_put(stp->module, stp->export[i].function, + stp->export[i].arity); + if (!on_load) { + ep->address = stp->export[i].address; + } else { + /* + * Don't make any of the exported functions + * callable yet. + */ + ep->address = ep->code+3; + ep->code[4] = (Eterm) stp->export[i].address; + } + } + + /* + * Import functions and patch all callers. + */ + + for (i = 0; i < stp->num_imports; i++) { + Eterm mod; + Eterm func; + Uint arity; + Uint import; + Uint current; + Uint next; + + mod = stp->import[i].module; + func = stp->import[i].function; + arity = stp->import[i].arity; + import = (Uint) erts_export_put(mod, func, arity); + current = stp->import[i].patches; + while (current != 0) { + ASSERT(current < stp->ci); + next = stp->code[current]; + stp->code[current] = import; + current = next; + } + } + + /* + * Fix all funs. + */ + + if (stp->num_lambdas > 0) { + for (i = 0; i < stp->num_lambdas; i++) { + unsigned entry_label = stp->lambdas[i].label; + ErlFunEntry* fe = stp->lambdas[i].fe; + Eterm* code_ptr = (Eterm *) (stp->code + stp->labels[entry_label].value); + + if (fe->address[0] != 0) { + /* + * We are hiding a pointer into older code. + */ + erts_refc_dec(&fe->refc, 1); + } + fe->address = code_ptr; +#ifdef HIPE + hipe_set_closure_stub(fe, stp->lambdas[i].num_free); +#endif + } + } +} + + +static int +transform_engine(LoaderState* st) +{ + Uint op; + int ap; /* Current argument. */ + Uint* restart; /* Where to restart if current match fails. */ + GenOpArg def_vars[TE_MAX_VARS]; /* Default buffer for variables. */ + GenOpArg* var = def_vars; + int i; /* General index. */ + Uint mask; + GenOp* instr; + Uint* pc; + int rval; + + ASSERT(gen_opc[st->genop->op].transform != -1); + pc = op_transform + gen_opc[st->genop->op].transform; + restart = pc; + + restart: + if (var != def_vars) { + erts_free(ERTS_ALC_T_LOADER_TMP, (void *) var); + var = def_vars; + } + ASSERT(restart != NULL); + pc = restart; + ASSERT(*pc < NUM_TOPS); /* Valid instruction? */ + ASSERT(*pc == TOP_try_me_else || *pc == TOP_fail); + instr = st->genop; + +#define RETURN(r) rval = (r); goto do_return; + +#ifdef DEBUG + restart = NULL; +#endif + ap = 0; + for (;;) { + op = *pc++; + + switch (op) { + case TOP_is_op: + 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; + 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; + case TOP_is_eq: + ASSERT(ap < instr->arity); + if (*pc++ != instr->a[ap].val) + goto restart; + break; + 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_r: 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].bf == NULL) + goto restart; + if (bif_number != -1 && + bif_export[bif_number]->code[4] != (Uint) st->import[i].bf) { + 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].bf != 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_rest_args) + case TOP_rest_args: + { + int n = *pc++; + var = erts_alloc(ERTS_ALC_T_LOADER_TMP, + instr->arity * sizeof(GenOpArg)); + for (i = 0; i < n; i++) { + var[i] = def_vars[i]; + } + while (i < instr->arity) { + var[i] = instr->a[i]; + i++; + } + } + break; +#endif + + case TOP_next_arg: + ap++; + break; + case TOP_next_instr: + instr = instr->next; + ap = 0; + break; + case TOP_commit: + instr = instr->next; /* The next_instr was optimized away. */ + + /* + * The left-hand side of this transformation matched. + * Delete all matched instructions. + */ + while (st->genop != instr) { + GenOp* next = st->genop->next; + FREE_GENOP(st, st->genop); + st->genop = next; + } +#ifdef DEBUG + instr = 0; +#endif + break; + +#if defined(TOP_call) + case TOP_call: + { + 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); + } + + instr = instr->next; /* The next_instr was optimized away. */ + + /* + * The left-hand side of this transformation matched. + * Delete all matched instructions. + */ + while (st->genop != instr) { + GenOp* next = st->genop->next; + FREE_GENOP(st, st->genop); + st->genop = next; + } + *lastp = st->genop; + st->genop = new_instr; + } + break; +#endif + case TOP_new_instr: + /* + * Note that the instructions are generated in reverse order. + */ + NEW_GENOP(st, instr); + instr->next = st->genop; + st->genop = instr; + ap = 0; + break; + case TOP_store_op: + instr->op = *pc++; + instr->arity = *pc++; + break; + case TOP_store_type: + i = *pc++; + instr->a[ap].type = i; + instr->a[ap].val = 0; + break; + case TOP_store_val: + i = *pc++; + instr->a[ap].val = i; + break; + case TOP_store_var: + i = *pc++; + ASSERT(i < TE_MAX_VARS); + instr->a[ap].type = var[i].type; + instr->a[ap].val = var[i].val; + break; + case TOP_try_me_else: + restart = pc + 1; + restart += *pc++; + ASSERT(*pc < NUM_TOPS); /* Valid instruction? */ + break; + case TOP_end: + RETURN(TE_OK); + case TOP_fail: + RETURN(TE_FAIL) + default: + ASSERT(0); + } + } +#undef RETURN + + do_return: + if (var != def_vars) { + erts_free(ERTS_ALC_T_LOADER_TMP, (void *) var); + } + return rval; +} + + +static void +short_file(int line, LoaderState* stp, unsigned needed) +{ + load_printf(line, stp, "unexpected end of %s when reading %d byte(s)", + stp->file_name, needed); +} + + +static void +load_printf(int line, LoaderState* context, char *fmt,...) +{ + erts_dsprintf_buf_t *dsbufp; + va_list va; + + if (is_non_value(context->module)) { + /* Suppressed by code:get_chunk/2 */ + return; + } + + dsbufp = erts_create_logger_dsbuf(); + + erts_dsprintf(dsbufp, "%s(%d): Error loading ", __FILE__, line); + + if (is_atom(context->function)) + erts_dsprintf(dsbufp, "function %T:%T/%d", context->module, + context->function, context->arity); + else + erts_dsprintf(dsbufp, "module %T", context->module); + + if (context->genop) + erts_dsprintf(dsbufp, ": op %s", gen_opc[context->genop->op].name); + + if (context->specific_op != -1) + erts_dsprintf(dsbufp, ": %s", opc[context->specific_op].sign); + else if (context->genop) { + int i; + for (i = 0; i < context->genop->arity; i++) + erts_dsprintf(dsbufp, " %c", + tag_to_letter[context->genop->a[i].type]); + } + + erts_dsprintf(dsbufp, ":\n "); + + va_start(va, fmt); + erts_vdsprintf(dsbufp, fmt, va); + va_end(va); + + erts_dsprintf(dsbufp, "\n"); +#ifdef DEBUG + erts_fprintf(stderr, "%s", dsbufp->str); +#endif + erts_send_error_to_logger(context->group_leader, dsbufp); +} + + +static int +get_int_val(LoaderState* stp, Uint len_code, Uint* result) +{ + Uint count; + Uint val; + + len_code >>= 5; + ASSERT(len_code < 8); + if (len_code == 7) { + LoadError0(stp, "can't load integers bigger than 8 bytes yet\n"); + } + count = len_code + 2; + if (count == 5) { + Uint msb; + GetByte(stp, msb); + if (msb == 0) { + count--; + } + GetInt(stp, 4, *result); + } else if (count <= 4) { + GetInt(stp, count, val); + *result = ((val << 8*(sizeof(val)-count)) >> 8*(sizeof(val)-count)); + } else { + LoadError1(stp, "too big integer; %d bytes\n", count); + } + return 1; + + load_error: + return 0; +} + + +static int +get_erlang_integer(LoaderState* stp, Uint len_code, Uint* result) +{ + Uint count; + Sint val; + byte default_buf[128]; + byte* bigbuf = default_buf; + byte* s; + int i; + int neg = 0; + Uint arity; + Eterm* hp; + + /* + * Retrieve the size of the value in bytes. + */ + + len_code >>= 5; + if (len_code < 7) { + count = len_code + 2; + } else { + Uint tag; + + ASSERT(len_code == 7); + GetTagAndValue(stp, tag, len_code); + VerifyTag(stp, TAG_u, tag); + count = len_code + 9; + } + + /* + * Handle values up to the size of an int, meaning either a small or bignum. + */ + + if (count <= sizeof(val)) { + GetInt(stp, count, val); + + val = ((val << 8*(sizeof(val)-count)) >> 8*(sizeof(val)-count)); + if (IS_SSMALL(val)) { + *result = val; + return TAG_i; + } else { + *result = new_literal(stp, &hp, BIG_UINT_HEAP_SIZE); + (void) small_to_big(val, hp); + return TAG_q; + } + } + + /* + * Make sure that the number will fit in our temporary buffer + * (including margin). + */ + + if (count+8 > sizeof(default_buf)) { + bigbuf = erts_alloc(ERTS_ALC_T_LOADER_TMP, count+8); + } + + /* + * Copy the number reversed to our temporary buffer. + */ + + GetString(stp, s, count); + for (i = 0; i < count; i++) { + bigbuf[count-i-1] = *s++; + } + + /* + * Check if the number is negative, and negate it if so. + */ + + if ((bigbuf[count-1] & 0x80) != 0) { + unsigned carry = 1; + + neg = 1; + for (i = 0; i < count; i++) { + bigbuf[i] = ~bigbuf[i] + carry; + carry = (bigbuf[i] == 0 && carry == 1); + } + ASSERT(carry == 0); + } + + /* + * Align to word boundary. + */ + + if (bigbuf[count-1] == 0) { + count--; + } + if (bigbuf[count-1] == 0) { + LoadError0(stp, "bignum not normalized"); + } + while (count % sizeof(Eterm) != 0) { + bigbuf[count++] = 0; + } + + /* + * Allocate heap space for the bignum and copy it. + */ + + arity = count/sizeof(Eterm); + *result = new_literal(stp, &hp, arity+1); + (void) bytes_to_big(bigbuf, count, neg, hp); + + if (bigbuf != default_buf) { + erts_free(ERTS_ALC_T_LOADER_TMP, (void *) bigbuf); + } + return TAG_q; + + load_error: + if (bigbuf != default_buf) { + erts_free(ERTS_ALC_T_LOADER_TMP, (void *) bigbuf); + } + return -1; +} + +/* + * Converts an IFF id to a printable string. + */ + +static void +id_to_string(Uint id, char* s) +{ + int i; + + for (i = 3; i >= 0; i--) { + *s++ = (id >> i*8) & 0xff; + } + *s++ = '\0'; +} + +static void +new_genop(LoaderState* stp) +{ + GenOpBlock* p = (GenOpBlock *) erts_alloc(ERTS_ALC_T_LOADER_TMP, + sizeof(GenOpBlock)); + int i; + + p->next = stp->genop_blocks; + stp->genop_blocks = p; + for (i = 0; i < sizeof(p->genop)/sizeof(p->genop[0])-1; i++) { + p->genop[i].next = p->genop + i + 1; + } + p->genop[i].next = NULL; + stp->free_genop = p->genop; +} + +static int +new_label(LoaderState* stp) +{ + int num = stp->num_labels; + + stp->num_labels++; + stp->labels = (Label *) erts_realloc(ERTS_ALC_T_LOADER_TMP, + (void *) stp->labels, + stp->num_labels * sizeof(Label)); + stp->labels[num].value = 0; + stp->labels[num].patches = 0; + return num; +} + +static void +new_literal_patch(LoaderState* stp, int pos) +{ + LiteralPatch* p = erts_alloc(ERTS_ALC_T_LOADER_TMP, sizeof(LiteralPatch)); + p->pos = pos; + p->next = stp->literal_patches; + stp->literal_patches = p; +} + +static void +new_string_patch(LoaderState* stp, int pos) +{ + StringPatch* p = erts_alloc(ERTS_ALC_T_LOADER_TMP, sizeof(StringPatch)); + p->pos = pos; + p->next = stp->string_patches; + stp->string_patches = p; +} + +static Uint +new_literal(LoaderState* stp, Eterm** hpp, Uint heap_size) +{ + Literal* lit; + + if (stp->allocated_literals == 0) { + Uint need; + + ASSERT(stp->literals == 0); + ASSERT(stp->num_literals == 0); + stp->allocated_literals = 8; + need = stp->allocated_literals * sizeof(Literal); + stp->literals = (Literal *) erts_alloc(ERTS_ALC_T_LOADER_TMP, + need); + } else if (stp->allocated_literals <= stp->num_literals) { + Uint need; + + stp->allocated_literals *= 2; + need = stp->allocated_literals * sizeof(Literal); + stp->literals = (Literal *) erts_realloc(ERTS_ALC_T_LOADER_TMP, + (void *) stp->literals, + need); + } + + stp->total_literal_size += heap_size; + lit = stp->literals + stp->num_literals; + lit->offset = 0; + lit->heap_size = heap_size; + lit->heap = erts_alloc(ERTS_ALC_T_LOADER_TMP, heap_size*sizeof(Eterm)); + lit->term = make_boxed(lit->heap); + *hpp = lit->heap; + return stp->num_literals++; +} + +Eterm +erts_module_info_0(Process* p, Eterm module) +{ + Eterm *hp; + Eterm list = NIL; + Eterm tup; + + if (is_not_atom(module)) { + return THE_NON_VALUE; + } + + if (erts_get_module(module) == NULL) { + return THE_NON_VALUE; + } + +#define BUILD_INFO(What) \ + tup = erts_module_info_1(p, module, What); \ + hp = HAlloc(p, 5); \ + tup = TUPLE2(hp, What, tup); \ + hp += 3; \ + list = CONS(hp, tup, list) + + BUILD_INFO(am_compile); + BUILD_INFO(am_attributes); + BUILD_INFO(am_imports); + BUILD_INFO(am_exports); +#undef BUILD_INFO + return list; +} + +Eterm +erts_module_info_1(Process* p, Eterm module, Eterm what) +{ + if (what == am_module) { + return module; + } else if (what == am_imports) { + return NIL; + } else if (what == am_exports) { + return exported_from_module(p, module); + } else if (what == am_functions) { + return functions_in_module(p, module); + } else if (what == am_attributes) { + return attributes_for_module(p, module); + } else if (what == am_compile) { + return compilation_info_for_module(p, module); + } else if (what == am_native_addresses) { + return native_addresses(p, module); + } + return THE_NON_VALUE; +} + +/* + * Builds a list of all functions in the given module: + * [{Name, Arity},...] + * + * Returns a tagged term, or 0 on error. + */ + +Eterm +functions_in_module(Process* p, /* Process whose heap to use. */ + Eterm mod) /* Tagged atom for module. */ +{ + Module* modp; + Eterm* code; + int i; + Uint num_functions; + Eterm* hp; + Eterm result = NIL; + + if (is_not_atom(mod)) { + return THE_NON_VALUE; + } + + modp = erts_get_module(mod); + if (modp == NULL) { + return THE_NON_VALUE; + } + code = modp->code; + num_functions = code[MI_NUM_FUNCTIONS]; + hp = HAlloc(p, 5*num_functions); + for (i = num_functions-1; i >= 0 ; i--) { + Eterm* func_info = (Eterm *) code[MI_FUNCTIONS+i]; + Eterm name = func_info[3]; + int arity = func_info[4]; + Eterm tuple; + + ASSERT(is_atom(name)); + tuple = TUPLE2(hp, name, make_small(arity)); + hp += 3; + result = CONS(hp, tuple, result); + hp += 2; + } + return result; +} + +/* + * Builds a list of all functions including native addresses. + * [{Name,Arity,NativeAddress},...] + * + * Returns a tagged term, or 0 on error. + */ + +static Eterm +native_addresses(Process* p, Eterm mod) +{ + Module* modp; + Eterm* code; + int i; + Eterm* hp; + Uint num_functions; + Uint need; + Eterm* hp_end; + Eterm result = NIL; + + if (is_not_atom(mod)) { + return THE_NON_VALUE; + } + + modp = erts_get_module(mod); + if (modp == NULL) { + return THE_NON_VALUE; + } + + code = modp->code; + num_functions = code[MI_NUM_FUNCTIONS]; + need = (6+BIG_UINT_HEAP_SIZE)*num_functions; + hp = HAlloc(p, need); + hp_end = hp + need; + for (i = num_functions-1; i >= 0 ; i--) { + Eterm* func_info = (Eterm *) code[MI_FUNCTIONS+i]; + Eterm name = func_info[3]; + int arity = func_info[4]; + Eterm tuple; + + ASSERT(is_atom(name)); + if (func_info[1] != 0) { + Eterm addr = erts_bld_uint(&hp, NULL, func_info[1]); + tuple = erts_bld_tuple(&hp, NULL, 3, name, make_small(arity), addr); + result = erts_bld_cons(&hp, NULL, tuple, result); + } + } + HRelease(p, hp_end, hp); + return result; +} + + +/* + * Builds a list of all exported functions in the given module: + * [{Name, Arity},...] + * + * Returns a tagged term, or 0 on error. + */ + +Eterm +exported_from_module(Process* p, /* Process whose heap to use. */ + Eterm mod) /* Tagged atom for module. */ +{ + int i; + Eterm* hp = NULL; + Eterm* hend = NULL; + Eterm result = NIL; + + if (is_not_atom(mod)) { + return THE_NON_VALUE; + } + + for (i = 0; i < export_list_size(); i++) { + Export* ep = export_list(i); + + if (ep->code[0] == mod) { + Eterm tuple; + + if (ep->address == ep->code+3 && + ep->code[3] == (Eterm) em_call_error_handler) { + /* There is a call to the function, but it does not exist. */ + continue; + } + + if (hp == hend) { + int need = 10 * 5; + hp = HAlloc(p, need); + hend = hp + need; + } + tuple = TUPLE2(hp, ep->code[1], make_small(ep->code[2])); + hp += 3; + result = CONS(hp, tuple, result); + hp += 2; + } + } + HRelease(p,hend,hp); + return result; +} + + +/* + * Returns a list of all attributes for the module. + * + * Returns a tagged term, or 0 on error. + */ + +Eterm +attributes_for_module(Process* p, /* Process whose heap to use. */ + Eterm mod) /* Tagged atom for module. */ + +{ + Module* modp; + Eterm* code; + Eterm* hp; + byte* ext; + Eterm result = NIL; + Eterm* end; + + if (is_not_atom(mod) || (is_not_list(result) && is_not_nil(result))) { + return THE_NON_VALUE; + } + + modp = erts_get_module(mod); + if (modp == NULL) { + return THE_NON_VALUE; + } + code = modp->code; + ext = (byte *) code[MI_ATTR_PTR]; + if (ext != NULL) { + hp = HAlloc(p, code[MI_ATTR_SIZE_ON_HEAP]); + end = hp + code[MI_ATTR_SIZE_ON_HEAP]; + result = erts_decode_ext(&hp, &MSO(p), &ext); + if (is_value(result)) { + ASSERT(hp <= end); + } + HRelease(p,end,hp); + } + return result; +} + + +/* + * Returns a list containing compilation information. + * + * Returns a tagged term, or 0 on error. + */ + +Eterm +compilation_info_for_module(Process* p, /* Process whose heap to use. */ + Eterm mod) /* Tagged atom for module. */ +{ + Module* modp; + Eterm* code; + Eterm* hp; + byte* ext; + Eterm result = NIL; + Eterm* end; + + if (is_not_atom(mod) || (is_not_list(result) && is_not_nil(result))) { + return THE_NON_VALUE; + } + + modp = erts_get_module(mod); + if (modp == NULL) { + return THE_NON_VALUE; + } + code = modp->code; + ext = (byte *) code[MI_COMPILE_PTR]; + if (ext != NULL) { + hp = HAlloc(p, code[MI_COMPILE_SIZE_ON_HEAP]); + end = hp + code[MI_COMPILE_SIZE_ON_HEAP]; + result = erts_decode_ext(&hp, &MSO(p), &ext); + if (is_value(result)) { + ASSERT(hp <= end); + } + HRelease(p,end,hp); + } + return result; +} + + +/* + * Returns a pointer to {module, function, arity}, or NULL if not found. + */ +Eterm* +find_function_from_pc(Eterm* pc) +{ + Range* low = modules; + Range* high = low + num_loaded_modules; + Range* mid = mid_module; + + while (low < high) { + if (pc < mid->start) { + high = mid; + } else if (pc > mid->end) { + low = mid + 1; + } else { + Eterm** low1 = (Eterm **) (mid->start + MI_FUNCTIONS); + Eterm** high1 = low1 + mid->start[MI_NUM_FUNCTIONS]; + Eterm** mid1; + + while (low1 < high1) { + mid1 = low1 + (high1-low1) / 2; + if (pc < mid1[0]) { + high1 = mid1; + } else if (pc < mid1[1]) { + mid_module = mid; + return mid1[0]+2; + } else { + low1 = mid1 + 1; + } + } + return NULL; + } + mid = low + (high-low) / 2; + } + return NULL; +} + +/* + * Read a specific chunk from a Beam binary. + */ + +Eterm +code_get_chunk_2(Process* p, Eterm Bin, Eterm Chunk) +{ + LoaderState state; + Uint chunk = 0; + ErlSubBin* sb; + Uint offset; + Uint bitoffs; + Uint bitsize; + byte* start; + int i; + Eterm res; + Eterm real_bin; + byte* temp_alloc = NULL; + + if ((start = erts_get_aligned_binary_bytes(Bin, &temp_alloc)) == NULL) { + error: + erts_free_aligned_binary_bytes(temp_alloc); + BIF_ERROR(p, BADARG); + } + state.module = THE_NON_VALUE; /* Suppress diagnostiscs */ + state.file_name = "IFF header for Beam file"; + state.file_p = start; + state.file_left = binary_size(Bin); + for (i = 0; i < 4; i++) { + Eterm* chunkp; + Eterm num; + if (is_not_list(Chunk)) { + goto error; + } + chunkp = list_val(Chunk); + num = CAR(chunkp); + Chunk = CDR(chunkp); + if (!is_byte(num)) { + goto error; + } + chunk = chunk << 8 | unsigned_val(num); + } + if (is_not_nil(Chunk)) { + goto error; + } + if (!scan_iff_file(&state, &chunk, 1, 1)) { + erts_free_aligned_binary_bytes(temp_alloc); + return am_undefined; + } + ERTS_GET_REAL_BIN(Bin, real_bin, offset, bitoffs, bitsize); + if (bitoffs) { + res = new_binary(p, state.chunks[0].start, state.chunks[0].size); + } else { + sb = (ErlSubBin *) HAlloc(p, ERL_SUB_BIN_SIZE); + sb->thing_word = HEADER_SUB_BIN; + sb->orig = real_bin; + sb->size = state.chunks[0].size; + sb->bitsize = 0; + sb->bitoffs = 0; + sb->offs = offset + (state.chunks[0].start - start); + sb->is_writable = 0; + res = make_binary(sb); + } + erts_free_aligned_binary_bytes(temp_alloc); + return res; +} + +/* + * Calculate the MD5 for a module. + */ + +Eterm +code_module_md5_1(Process* p, Eterm Bin) +{ + LoaderState state; + byte* temp_alloc = NULL; + + if ((state.file_p = erts_get_aligned_binary_bytes(Bin, &temp_alloc)) == NULL) { + BIF_ERROR(p, BADARG); + } + state.module = THE_NON_VALUE; /* Suppress diagnostiscs */ + state.file_name = "IFF header for Beam file"; + state.file_left = binary_size(Bin); + + if (!scan_iff_file(&state, chunk_types, NUM_CHUNK_TYPES, NUM_MANDATORY)) { + return am_undefined; + } + erts_free_aligned_binary_bytes(temp_alloc); + return new_binary(p, state.mod_md5, sizeof(state.mod_md5)); +} + +#define WORDS_PER_FUNCTION 6 + +static Eterm* +make_stub(Eterm* fp, Eterm mod, Eterm func, Uint arity, Uint native, Eterm OpCode) +{ + fp[0] = (Eterm) BeamOp(op_i_func_info_IaaI); + fp[1] = native; + fp[2] = mod; + fp[3] = func; + fp[4] = arity; +#ifdef HIPE + if (native) { + fp[5] = BeamOpCode(op_move_return_nr); + hipe_mfa_save_orig_beam_op(mod, func, arity, fp+5); + } +#endif + fp[5] = OpCode; + return fp + WORDS_PER_FUNCTION; +} + +static byte* +stub_copy_info(LoaderState* stp, + int chunk, /* Chunk: ATTR_CHUNK or COMPILE_CHUNK */ + byte* info, /* Where to store info. */ + Eterm* ptr_word, /* Where to store pointer into info. */ + Eterm* size_word) /* Where to store size of info. */ +{ + Sint decoded_size; + Uint size = stp->chunks[chunk].size; + if (size != 0) { + memcpy(info, stp->chunks[chunk].start, size); + *ptr_word = (Eterm) info; + decoded_size = erts_decode_ext_size(info, size, 0); + if (decoded_size < 0) { + return 0; + } + *size_word = decoded_size; + } + return info + size; +} + +static int +stub_read_export_table(LoaderState* stp) +{ + int i; + + GetInt(stp, 4, stp->num_exps); + if (stp->num_exps > stp->num_functions) { + LoadError2(stp, "%d functions exported; only %d functions defined", + stp->num_exps, stp->num_functions); + } + stp->export + = (ExportEntry *) erts_alloc(ERTS_ALC_T_LOADER_TMP, + stp->num_exps * sizeof(ExportEntry)); + + for (i = 0; i < stp->num_exps; i++) { + Uint n; + + GetInt(stp, 4, n); + GetAtom(stp, n, stp->export[i].function); + GetInt(stp, 4, n); + if (n > MAX_REG) { + LoadError2(stp, "export table entry %d: absurdly high arity %d", i, n); + } + stp->export[i].arity = n; + GetInt(stp, 4, n); /* Ignore label */ + } + return 1; + + load_error: + return 0; +} + +static void +stub_final_touch(LoaderState* stp, Eterm* fp) +{ + int i; + int n = stp->num_exps; + Eterm function = fp[3]; + int arity = fp[4]; +#ifdef HIPE + Lambda* lp; +#endif + + /* + * Test if the function should be exported. + */ + + for (i = 0; i < n; i++) { + if (stp->export[i].function == function && stp->export[i].arity == arity) { + Export* ep = erts_export_put(fp[2], function, arity); + ep->address = fp+5; + return; + } + } + + /* + * Must be a plain local function or a lambda local function. + * Search the lambda table to find out which. + */ + +#ifdef HIPE + n = stp->num_lambdas; + for (i = 0, lp = stp->lambdas; i < n; i++, lp++) { + ErlFunEntry* fe = stp->lambdas[i].fe; + if (lp->function == function && lp->arity == arity) { + fp[5] = (Eterm) BeamOpCode(op_hipe_trap_call_closure); + fe->address = &(fp[5]); + } + } +#endif + return; +} + + +/* Takes an erlang list of addresses: + [{Adr, Patchtyppe} | Addresses] + and the address of a fun_entry. +*/ +int +patch(Eterm Addresses, Uint fe) + { +#ifdef HIPE + Eterm* listp; + Eterm tuple; + Eterm* tp; + Eterm patchtype; + Uint AddressToPatch; + + while (!is_nil(Addresses)) { + listp = list_val(Addresses); + + tuple = CAR(listp); + if (is_not_tuple(tuple)) { + return 0; /* Signal error */ + } + + tp = tuple_val(tuple); + if (tp[0] != make_arityval(2)) { + return 0; /* Signal error */ + } + + if(term_to_Uint(tp[1], &AddressToPatch) == 0) { + return 0; /* Signal error */ + } + + patchtype = tp[2]; + if (is_not_atom(patchtype)) { + return 0; /* Signal error */ + } + + hipe_patch_address((Uint *)AddressToPatch, patchtype, fe); + + Addresses = CDR(listp); + + + } + +#endif + return 1; +} + + +int +patch_funentries(Eterm Patchlist) + { +#ifdef HIPE + while (!is_nil(Patchlist)) { + Eterm Info; + Eterm MFA; + Eterm Addresses; + Eterm tuple; + Eterm Mod; + Eterm* listp; + Eterm* tp; + ErlFunEntry* fe; + Uint index; + Uint uniq; + Uint native_address; + + listp = list_val(Patchlist); + tuple = CAR(listp); + Patchlist = CDR(listp); + + if (is_not_tuple(tuple)) { + return 0; /* Signal error */ + } + + tp = tuple_val(tuple); + if (tp[0] != make_arityval(3)) { + return 0; /* Signal error */ + } + + Info = tp[1]; + if (is_not_tuple(Info)) { + return 0; /* Signal error */ + } + Addresses = tp[2]; + if (is_not_list(Addresses)) { + return 0; /* Signal error */ + } + + if(term_to_Uint(tp[3], &native_address) == 0) { + return 0; /* Signal error */ + } + + + + tp = tuple_val(Info); + if (tp[0] != make_arityval(3)) { + return 0; /* Signal error */ + } + MFA = tp[1]; + if (is_not_tuple(MFA)) { + return 0; /* Signal error */ + } + if(term_to_Uint(tp[2], &uniq) == 0){ + return 0; /* Signal error */ + } + if(term_to_Uint(tp[3], &index) == 0) { + return 0; /* Signal error */ + } + + + + + tp = tuple_val(MFA); + if (tp[0] != make_arityval(3)) { + return 0; /* Signal error */ + } + Mod = tp[1]; + if (is_not_atom(Mod)) { + return 0; /* Signal error */ + } + + + + fe = erts_get_fun_entry(Mod, uniq, index); + fe->native_address = (Uint *)native_address; + erts_refc_dec(&fe->refc, 1); + + if (!patch(Addresses, (Uint) fe)) + return 0; + + } +#endif + return 1; /* Signal that all went well */ +} + + +/* + * Do a dummy load of a module. No threaded code will be loaded. + * Used for loading native code. + * Will also patch all references to fun_entries to point to + * the new fun_entries created. + */ + +Eterm +erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info) +{ + LoaderState state; + Eterm Funcs; + Eterm Patchlist; + Eterm* tp; + Eterm* code = NULL; + Eterm* ptrs; + Eterm* fp; + byte* info; + Uint ci; + int n; + int code_size; + int rval; + int i; + ErlDrvBinary* bin = NULL; + byte* temp_alloc = NULL; + byte* bytes; + Uint size; + + /* + * Must initialize state.lambdas here because the error handling code + * at label 'error' uses it. + */ + init_state(&state); + + if (is_not_atom(Mod)) { + goto error; + } + if (is_not_tuple(Info)) { + goto error; + } + tp = tuple_val(Info); + if (tp[0] != make_arityval(2)) { + goto error; + } + Funcs = tp[1]; + Patchlist = tp[2]; + + if ((n = list_length(Funcs)) < 0) { + goto error; + } + if ((bytes = erts_get_aligned_binary_bytes(Beam, &temp_alloc)) == NULL) { + goto error; + } + size = binary_size(Beam); + + /* + * Uncompressed if needed. + */ + if (!(size >= 4 && bytes[0] == 'F' && bytes[1] == 'O' && + bytes[2] == 'R' && bytes[3] == '1')) { + bin = (ErlDrvBinary *) erts_gzinflate_buffer((char*)bytes, size); + if (bin == NULL) { + goto error; + } + bytes = (byte*)bin->orig_bytes; + size = bin->orig_size; + } + + /* + * Scan the Beam binary and read the interesting sections. + */ + + state.file_name = "IFF header for Beam file"; + state.file_p = bytes; + state.file_left = size; + state.module = Mod; + state.group_leader = p->group_leader; + state.num_functions = n; + if (!scan_iff_file(&state, chunk_types, NUM_CHUNK_TYPES, NUM_MANDATORY)) { + goto error; + } + define_file(&state, "code chunk header", CODE_CHUNK); + if (!read_code_header(&state)) { + goto error; + } + define_file(&state, "atom table", ATOM_CHUNK); + if (!load_atom_table(&state)) { + goto error; + } + define_file(&state, "export table", EXP_CHUNK); + if (!stub_read_export_table(&state)) { + goto error; + } + + if (state.chunks[LAMBDA_CHUNK].size > 0) { + define_file(&state, "lambda (fun) table", LAMBDA_CHUNK); + if (!read_lambda_table(&state)) { + goto error; + } + } + + /* + * Allocate memory for the stub module. + */ + + code_size = ((WORDS_PER_FUNCTION+1)*n + MI_FUNCTIONS + 2) * sizeof(Eterm); + code_size += state.chunks[ATTR_CHUNK].size; + code_size += state.chunks[COMPILE_CHUNK].size; + code = erts_alloc_fnf(ERTS_ALC_T_CODE, code_size); + if (!code) { + goto error; + } + + /* + * Initialize code area. + */ + + code[MI_NUM_FUNCTIONS] = n; + code[MI_ATTR_PTR] = 0; + code[MI_ATTR_SIZE_ON_HEAP] = 0; + code[MI_COMPILE_PTR] = 0; + code[MI_COMPILE_SIZE_ON_HEAP] = 0; + code[MI_NUM_BREAKPOINTS] = 0; + ci = MI_FUNCTIONS + n + 1; + + /* + * Make stubs for all functions. + */ + + ptrs = code + MI_FUNCTIONS; + fp = code + ci; + for (i = 0; i < n; i++) { + Eterm* listp; + Eterm tuple; + Eterm* tp; + Eterm func; + Eterm arity_term; + Uint arity; + Uint native_address; + Eterm op; + + if (is_nil(Funcs)) { + break; + } + listp = list_val(Funcs); + tuple = CAR(listp); + Funcs = CDR(listp); + + /* Error checking */ + if (is_not_tuple(tuple)) { + goto error; + } + tp = tuple_val(tuple); + if (tp[0] != make_arityval(3)) { + goto error; + } + func = tp[1]; + arity_term = tp[2]; + if (is_not_atom(func) || is_not_small(arity_term)) { + goto error; + } + arity = signed_val(arity_term); + if (arity < 0) { + goto error; + } + if (term_to_Uint(tp[3], &native_address) == 0) { + goto error; + } + + /* + * Set the pointer and make the stub. Put a return instruction + * as the body until we know what kind of trap we should put there. + */ + ptrs[i] = (Eterm) fp; +#ifdef HIPE + op = (Eterm) BeamOpCode(op_hipe_trap_call); /* Might be changed later. */ +#else + op = (Eterm) BeamOpCode(op_move_return_nr); +#endif + fp = make_stub(fp, Mod, func, arity, (Uint)native_address, op); + } + + /* + * Insert the last pointer and the int_code_end instruction. + */ + + ptrs[i] = (Eterm) fp; + *fp++ = (Eterm) BeamOp(op_int_code_end); + + /* + * Copy attributes and compilation information. + */ + + info = (byte *) fp; + info = stub_copy_info(&state, ATTR_CHUNK, info, + code+MI_ATTR_PTR, code+MI_ATTR_SIZE_ON_HEAP); + if (info == NULL) { + goto error; + } + info = stub_copy_info(&state, COMPILE_CHUNK, info, + code+MI_COMPILE_PTR, code+MI_COMPILE_SIZE_ON_HEAP); + if (info == NULL) { + goto error; + } + + /* + * Insert the module in the module table. + */ + + rval = insert_new_code(p, 0, p->group_leader, Mod, code, code_size, + BEAM_CATCHES_NIL); + if (rval < 0) { + goto error; + } + + /* + * Export all stub functions and insert the correct type of HiPE trap. + */ + + fp = code + ci; + for (i = 0; i < n; i++) { + stub_final_touch(&state, fp); + fp += WORDS_PER_FUNCTION; + } + + if (patch_funentries(Patchlist)) { + erts_free_aligned_binary_bytes(temp_alloc); + if (state.lambdas != state.def_lambdas) { + erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.lambdas); + } + if (bin != NULL) { + driver_free_binary(bin); + } + return Mod; + } + + error: + erts_free_aligned_binary_bytes(temp_alloc); + if (code != NULL) { + erts_free(ERTS_ALC_T_CODE, code); + } + if (state.lambdas != state.def_lambdas) { + erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.lambdas); + } + if (bin != NULL) { + driver_free_binary(bin); + } + + + BIF_ERROR(p, BADARG); +} + +#undef WORDS_PER_FUNCTION + +static int safe_mul(Uint a, Uint b, Uint* resp) +{ + Uint res = a * b; + *resp = res; + + if (b == 0) { + return 1; + } else { + return (res / b) == a; + } +} |