erts/emulator/beam/beam_load.c

/*
 * %CopyrightBegin%
 *
 * Copyright Ericsson AB 1996-2020. All Rights Reserved.
 *
 * Licensed under the Apache License, Version 2.0 (the "License");
 * you may not use this file except in compliance with the License.
 * You may obtain a copy of the License at
 *
 *     http://www.apache.org/licenses/LICENSE-2.0
 *
 * Unless required by applicable law or agreed to in writing, software
 * distributed under the License is distributed on an "AS IS" BASIS,
 * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 * See the License for the specific language governing permissions and
 * limitations under the License.
 *
 * %CopyrightEnd%
 */

#ifdef HAVE_CONFIG_H
#  include "config.h"
#endif

#include "sys.h"
#include "erl_vm.h"
#include "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 "beam_bp.h"
#include "big.h"
#include "erl_bits.h"
#include "beam_catches.h"
#include "erl_binary.h"
#include "erl_zlib.h"
#include "erl_map.h"
#include "erl_process_dict.h"
#include "erl_unicode.h"
#include "beam_file.h"

#ifdef HIPE
#error "FIXME: reintroduce HiPE support"
#endif

Uint erts_total_code_size;

static int load_code(LoaderState *stp);

/**********************************************************************/

void init_load(void)
{
    erts_total_code_size = 0;
    beam_catches_init();
    erts_init_ranges();
}

Binary *erts_alloc_loader_state(void) {
    LoaderState* stp;
    Binary* magic;

    magic = erts_create_magic_binary(sizeof(LoaderState),
                                     beam_load_prepared_dtor);
    erts_refc_inc(&magic->intern.refc, 1);

    stp = ERTS_MAGIC_BIN_DATA(magic);

    sys_memset(stp, 0, sizeof(*stp));

    /* Function not known yet */
    stp->function = THE_NON_VALUE;
    stp->specific_op = -1;

    beamopallocator_init(&stp->op_allocator);

    return magic;
}

Eterm
erts_preload_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 */
                    Uint size)          /* Size of code to load. */
{
    Binary* magic = erts_alloc_loader_state();
    Eterm retval;

    ASSERT(!erts_initialized);
    retval = erts_prepare_loading(magic, c_p, group_leader, modp,
                                  code, size);

    if (retval != NIL) {
        return retval;
    }

    return erts_finish_loading(magic, c_p, c_p_locks, modp);
}

Eterm
erts_prepare_loading(Binary* magic, Process *c_p, Eterm group_leader,
                     Eterm* modp, byte* code, Uint unloaded_size)
{
    enum beamfile_read_result read_result;
    Eterm retval = am_badfile;
    LoaderState* stp;

    stp = ERTS_MAGIC_BIN_DATA(magic);
    stp->module = *modp;
    stp->group_leader = group_leader;

#if defined(LOAD_MEMORY_HARD_DEBUG) && defined(DEBUG)
    erts_fprintf(stderr,"Loading a module\n");
#endif

    read_result = beamfile_read(code,
                                unloaded_size,
                                &stp->beam);

    switch(read_result) {
    case BEAMFILE_READ_CORRUPT_FILE_HEADER:
        BeamLoadError0(stp, "corrupt file header");
    case BEAMFILE_READ_MISSING_ATOM_TABLE:
        BeamLoadError0(stp, "missing atom table");
    case BEAMFILE_READ_CORRUPT_ATOM_TABLE:
        BeamLoadError0(stp, "corrupt atom table");
    case BEAMFILE_READ_MISSING_CODE_CHUNK:
        BeamLoadError0(stp, "missing code chunk");
    case BEAMFILE_READ_CORRUPT_CODE_CHUNK:
        BeamLoadError0(stp, "corrupt code chunk");
    case BEAMFILE_READ_MISSING_EXPORT_TABLE:
        BeamLoadError0(stp, "missing export table");
    case BEAMFILE_READ_CORRUPT_EXPORT_TABLE:
        BeamLoadError0(stp, "corrupt export table");
    case BEAMFILE_READ_MISSING_IMPORT_TABLE:
        BeamLoadError0(stp, "missing import table");
    case BEAMFILE_READ_CORRUPT_IMPORT_TABLE:
        BeamLoadError0(stp, "corrupt import table");
    case BEAMFILE_READ_CORRUPT_LAMBDA_TABLE:
        BeamLoadError0(stp, "corrupt lambda table");
    case BEAMFILE_READ_CORRUPT_LINE_TABLE:
        BeamLoadError0(stp, "corrupt line table");
    case BEAMFILE_READ_CORRUPT_LITERAL_TABLE:
        BeamLoadError0(stp, "corrupt literal table");
    case BEAMFILE_READ_SUCCESS:
        break;
    }

    ERTS_ASSERT(read_result == BEAMFILE_READ_SUCCESS);

    if (stp->module != stp->beam.module) {
        BeamLoadError1(stp, "module name in object code is %T", stp->beam.module);
    }

    if (stp->beam.code.max_opcode > MAX_GENERIC_OPCODE) {
        BeamLoadError2(stp,
                       "This BEAM file was compiled for a later version"
                       " of the run-time system than " ERLANG_OTP_RELEASE ".\n"
                       "  To fix this, please recompile this module with an "
                       ERLANG_OTP_RELEASE " compiler.\n"
                       "  (Use of opcode %d; this emulator supports "
                       "only up to %d.)",
                       stp->beam.code.max_opcode, MAX_GENERIC_OPCODE);
    }

    stp->otp_20_or_higher = (stp->beam.atoms.encoding == ERTS_ATOM_ENC_UTF8);

    if (!load_code(stp)) {
        goto load_error;
    }

    /* Good so far */
    retval = NIL;

 load_error:
    if (retval != NIL) {
        beam_load_prepared_free(magic);
    }

    return retval;
}

Eterm
erts_finish_loading(Binary* magic, Process* c_p,
                    ErtsProcLocks c_p_locks, Eterm* modp)
{
    Eterm retval = NIL;
    LoaderState* stp = ERTS_MAGIC_BIN_DATA(magic);

    struct erl_module_instance* inst_p;
    Module* mod_tab_p;

    ERTS_LC_ASSERT(erts_initialized == 0 || erts_has_code_write_permission() ||
                       erts_thr_progress_is_blocking());

    /* Make current code for the module old and insert the new code
     * as current. This will fail if there already exists old code
     * for the module. */
    mod_tab_p = erts_put_module(stp->module);
    if (!stp->on_load) {
        /* Normal case -- no -on_load() function. */
        retval = beam_make_current_old(c_p, c_p_locks, stp->module);
        ASSERT(retval == NIL);
    } else {
        ErtsCodeIndex code_ix = erts_staging_code_ix();
        Eterm module = stp->module;
        int i, num_exps;

        /*
         * There is an -on_load() function. We will keep the current
         * code, but we must turn off any tracing.
         */
        num_exps = export_list_size(code_ix);
        for (i = 0; i < num_exps; i++) {
            Export *ep = export_list(i, code_ix);

            if (ep == NULL || ep->info.mfa.module != module) {
                continue;
            }

            DBG_CHECK_EXPORT(ep, code_ix);

            if (ep->addressv[code_ix] == ep->trampoline.raw) {
                if (BeamIsOpCode(ep->trampoline.common.op, op_i_generic_breakpoint)) {
                    ERTS_LC_ASSERT(erts_thr_progress_is_blocking());
                    ASSERT(mod_tab_p->curr.num_traced_exports > 0);

                    erts_clear_export_break(mod_tab_p, ep);

                    ep->addressv[code_ix] =
                        (BeamInstr*)ep->trampoline.breakpoint.address;
                    ep->trampoline.breakpoint.address = 0;

                    ASSERT(ep->addressv[code_ix] != ep->trampoline.raw);
                }
                ASSERT(ep->trampoline.breakpoint.address == 0);
            }
        }
        ASSERT(mod_tab_p->curr.num_breakpoints == 0);
        ASSERT(mod_tab_p->curr.num_traced_exports == 0);
    }

    /* Update module table. */
    if (!stp->on_load) {
        inst_p = &mod_tab_p->curr;
    } else {
        mod_tab_p->on_load = erts_alloc(ERTS_ALC_T_PREPARED_CODE,
                                        sizeof(struct erl_module_instance));
        inst_p = mod_tab_p->on_load;
        erts_module_instance_init(inst_p);
    }

    beam_load_finalize_code(stp, inst_p);

#if defined(LOAD_MEMORY_HARD_DEBUG) && defined(DEBUG)
    erts_fprintf(stderr,"Loaded %T\n",*modp);
#if 0
    debug_dump_code(stp->code,stp->ci);
#endif
#endif

    *modp = stp->module;

    /* If there is an on_load function, signal an error to
     * indicate that the on_load function must be run. */
    if (stp->on_load) {
        retval = am_on_load;
    }

    beam_load_prepared_free(magic);
    return retval;
}

/* Return a non-zero value if the module has an on_load function,
 * or 0 if it does not. */
Eterm erts_has_code_on_load(Binary* magic)
{
    LoaderState* stp;

    if (ERTS_MAGIC_BIN_DESTRUCTOR(magic) != beam_load_prepared_dtor) {
        return NIL;
    }

    stp = ERTS_MAGIC_BIN_DATA(magic);

    return stp->on_load ? am_true : am_false;
}

/* Return the module name (a tagged atom) for the prepared code
 * in the magic binary, or NIL if the binary does not contain
 * prepared code. */
Eterm
erts_module_for_prepared_code(Binary* magic)
{
    LoaderState* stp;

    if (ERTS_MAGIC_BIN_DESTRUCTOR(magic) != beam_load_prepared_dtor) {
        return NIL;
    }

    stp = ERTS_MAGIC_BIN_DATA(magic);

    if (stp->code_hdr) {
        return stp->module;
    } else {
        return NIL;
    }
}

void beam_load_report_error(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 load_code(LoaderState* stp)
{
    BeamOp* last_op = NULL;
    BeamOp** last_op_next = NULL;

    BeamCodeReader *op_reader;
    BeamOp *tmp_op;

    int num_specific;

    beam_load_prepare_emit(stp);

    op_reader = beamfile_get_code(&stp->beam, &stp->op_allocator);

    for (;;) {
    get_next_instr:
        if (!beamcodereader_next(op_reader, &last_op)) {
            BeamLoadError0(stp, "invalid opcode");
        }

        /*
         * 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;
            }
        }

        last_op->next = NULL;
        *last_op_next = last_op;
        last_op_next = &(last_op->next);
        stp->specific_op = -1;

    do_transform:
        ASSERT(stp->genop != NULL);
        if (gen_opc[stp->genop->op].transform != -1) {
            if (stp->genop->next == NULL) {
                /*
                 * Simple heuristic: Most transformations requires
                 * at least two instructions, so make sure that
                 * there are. That will reduce the number of
                 * TE_SHORT_WINDOWs.
                 */
                goto get_next_instr;
            }
            switch (erts_transform_engine(stp)) {
            case TE_FAIL:
                /*
                 * No transformation found. stp->genop != NULL and
                 * last_op_next is still valid. Go ahead and load
                 * the instruction.
                 */
                break;
            case TE_OK:
                /*
                 * Some transformation was applied. last_op_next is
                 * no longer valid and stp->genop may be NULL.
                 * Try to transform again.
                 */
                if (stp->genop == NULL) {
                    last_op_next = &stp->genop;
                    goto get_next_instr;
                }
                last_op_next = NULL;
                goto do_transform;
            case TE_SHORT_WINDOW:
                /*
                 * No transformation applied. stp->genop != NULL and
                 * last_op_next is still valid. Fetch a new instruction
                 * before trying the transformation again.
                 */
                goto get_next_instr;
            }
        }

        /* From the collected generic instruction, find the specific
         * instruction. */
	tmp_op = stp->genop;
	num_specific = gen_opc[tmp_op->op].num_specific;
	if (num_specific == 1) {
	    /*
	     * There is only one possible specific instruction. Note that
	     * the operands for the instruction will be verified later.
	     */
	    stp->specific_op = gen_opc[tmp_op->op].specific;
	} else {
	    /*
	     * Use bit masks to quickly find the most specific of the
	     * the possible specific instructions associated with this
	     * specific instruction.
	     */
            Uint32 mask[3] = {0, 0, 0};

            int specific, arity, arg, i;

            arity = gen_opc[tmp_op->op].arity;
            if (arity > 6) {
                BeamLoadError0(stp, "no specific operation found (arity > 6)");
            }

            for (arg = 0; arg < arity; arg++) {
                int type = tmp_op->a[arg].type;

                mask[arg / 2] |= (1u << type) << ((arg % 2) << 4);
            }

            specific = gen_opc[tmp_op->op].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])) {
#ifdef BEAMASM
		    /* Go ahead and match. */
		    break;
#else
                    if (!opc[specific].involves_r) {
                        /* No complications - match */
                        break;
                    }

                    /*
                     * The specific operation uses the 'r' operand,
                     * which is shorthand for x(0). Now things
                     * get complicated. First we must check whether
                     * all operands that should be of type 'r' use
                     * x(0) (as opposed to some other X register).
                     */
                    for (arg = 0; arg < arity; arg++) {
                        if (opc[specific].involves_r & (1 << arg) &&
                            tmp_op->a[arg].type == TAG_x) {
                            if (tmp_op->a[arg].val != 0) {
                                break; /* Other X register than 0 */
                            }
                        }
                    }

                    if (arg == arity) {
                        /*
                         * All 'r' operands use x(0) in the generic
                         * operation. That means a match. Now we
                         * will need to rewrite the generic instruction
                         * to actually use 'r' instead of 'x(0)'.
                         */
                        for (arg = 0; arg < arity; arg++) {
                            if (opc[specific].involves_r & (1 << arg) &&
                                tmp_op->a[arg].type == TAG_x) {
                                tmp_op->a[arg].type = TAG_r;
                            }
                        }

                        /* Match */
                        break;
                    }
#endif
                }
                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) {
                        BeamLoadError0(stp, "the character data type is 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) {
                    BeamLoadError0(stp, "please re-compile this module with an "
                                   ERLANG_OTP_RELEASE " compiler ");
                }

                /*
                 * Some generic instructions should have a special
                 * error message.
                 */
                switch (stp->genop->op) {
                case genop_too_old_compiler_0:
                    BeamLoadError0(stp, "please re-compile this module with an "
                                   ERLANG_OTP_RELEASE " compiler");
                case genop_unsupported_guard_bif_3:
                    {
                        Eterm Mod = (Eterm) stp->genop->a[0].val;
                        Eterm Name = (Eterm) stp->genop->a[1].val;
                        Uint arity = (Uint) stp->genop->a[2].val;

                        beamopallocator_free_op(&stp->op_allocator,
                                                stp->genop);

                        stp->genop = NULL;
                        BeamLoadError3(stp, "unsupported guard BIF: %T:%T/%d\n",
                                       Mod, Name, arity);
                    }
                default:
                    BeamLoadError0(stp, "no specific operation found");
                }
            }

            stp->specific_op = specific;
        }

        if (!beam_load_emit_op(stp, tmp_op)) {
            goto load_error;
        }

        if (stp->specific_op != -1) {
            /* Delete the generic instruction just loaded. */
            BeamOp* next = (stp->genop)->next;

            beamopallocator_free_op(&stp->op_allocator, stp->genop);

            stp->genop = next;
            if (next != NULL) {
                goto do_transform;
            }

            last_op_next = &stp->genop;
        } else {
            /* End of code found */
            break;
        }
    }

    beamcodereader_close(op_reader);
    beamopallocator_dtor(&stp->op_allocator);

    return beam_load_finish_emit(stp);

load_error:
    beamcodereader_close(op_reader);
    beamopallocator_dtor(&stp->op_allocator);
    return 0;
}

#ifdef HIPE
static Eterm
stub_insert_new_code(Process *c_p, ErtsProcLocks c_p_locks,
                     Eterm group_leader, Eterm module,
                     BeamCodeHeader* code_hdr, Uint size,
                     HipeModule *hipe_code)
{
    Module* modp;
    Eterm retval;

    if ((retval = beam_make_current_old(c_p, c_p_locks, module)) != NIL) {
        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 retval;
    }

    /*
     * Update module table.
     */

    erts_total_code_size += size;
    modp = erts_put_module(module);
    modp->curr.code_hdr = code_hdr;
    modp->curr.code_length = size;
    modp->curr.catches = BEAM_CATCHES_NIL; /* Will be filled in later. */
    DBG_TRACE_MFA(make_atom(modp->module), 0, 0, "insert_new_code "
                  "first_hipe_ref = %p", hipe_code->first_hipe_ref);
    modp->curr.hipe_code = hipe_code;

    /*
     * Update ranges (used for finding a function from a PC value).
     */

    erts_update_ranges((BeamInstr*)modp->curr.code_hdr, size);
    return NIL;
}
#endif

void
erts_release_literal_area(ErtsLiteralArea* literal_area)
{
    struct erl_off_heap_header* oh;

    if (!literal_area)
        return;

    oh = literal_area->off_heap;

    while (oh) {
        switch (thing_subtag(oh->thing_word)) {
        case REFC_BINARY_SUBTAG:
            {
                Binary* bptr = ((ProcBin*)oh)->val;
                erts_bin_release(bptr);
                break;
            }
        case FUN_SUBTAG:
            {
                ErlFunEntry* fe = ((ErlFunThing*)oh)->fe;
                if (erts_refc_dectest(&fe->refc, 0) == 0) {
                    erts_erase_fun_entry(fe);
                }
                break;
            }
        case REF_SUBTAG:
            {
                ErtsMagicBinary *bptr;
                ASSERT(is_magic_ref_thing(oh));
                bptr = ((ErtsMRefThing *) oh)->mb;
                erts_bin_release((Binary *) bptr);
                break;
            }
        default:
            ASSERT(is_external_header(oh->thing_word));
            erts_deref_node_entry(((ExternalThing*)oh)->node,
                                  make_boxed(&oh->thing_word));
        }
        oh = oh->next;
    }
    erts_free(ERTS_ALC_T_LITERAL, literal_area);
}

int
erts_is_module_native(BeamCodeHeader* code_hdr)
{
    Uint i, num_functions;

    /* Check NativeAdress of first real function in module */
    if (code_hdr != NULL) {
        num_functions = code_hdr->num_functions;
        for (i=0; i<num_functions; i++) {
            ErtsCodeInfo* ci = code_hdr->functions[i];
            if (is_atom(ci->mfa.function)) {
                return erts_is_function_native(ci);
            }
            else ASSERT(is_nil(ci->mfa.function)); /* ignore BIF stubs */
        }
    }
    return 0;
}

int
erts_is_function_native(ErtsCodeInfo *ci)
{
#ifdef HIPE
    ASSERT(BeamIsOpCode(ci->op, op_i_func_info_IaaI));
    return BeamIsOpCode(erts_codeinfo_to_code(ci)[0], op_hipe_trap_call) ||
        BeamIsOpCode(erts_codeinfo_to_code(ci)[0], op_hipe_trap_call_closure);
#else
    return 0;
#endif
}

#ifdef ENABLE_DBG_TRACE_MFA

#define MFA_MAX 10
Eterm dbg_trace_m[MFA_MAX];
Eterm dbg_trace_f[MFA_MAX];
Uint  dbg_trace_a[MFA_MAX];
unsigned int dbg_trace_ix = 0;

void dbg_set_traced_mfa(const char* m, const char* f, Uint a)
{
    unsigned i = dbg_trace_ix++;
    ASSERT(i < MFA_MAX);
    dbg_trace_m[i] = am_atom_put(m, sys_strlen(m));
    dbg_trace_f[i] = am_atom_put(f, sys_strlen(f));
    dbg_trace_a[i] = a;
}

int dbg_is_traced_mfa(Eterm m, Eterm f, Uint a)
{
    unsigned int i;
    for (i = 0; i < dbg_trace_ix; ++i) {
        if (m == dbg_trace_m[i] &&
            (!f || (f == dbg_trace_f[i] && a == dbg_trace_a[i]))) {

            return i+1;
        }
    }
    return 0;
}

void dbg_vtrace_mfa(unsigned ix, const char* format, ...)
{
    va_list arglist;
    va_start(arglist, format);
    ASSERT(--ix < MFA_MAX);
    erts_fprintf(stderr, "MFA TRACE %T:%T/%u: ",
                 dbg_trace_m[ix], dbg_trace_f[ix], (int)dbg_trace_a[ix]);

    erts_vfprintf(stderr, format, arglist);
    va_end(arglist);
}

#endif /* ENABLE_DBG_TRACE_MFA */