hipe_bif0.c

OTP是开放电信平台的简称

/* $Id$
 * hipe_bif0.c
 *
 * Compiler and linker support.
 */

#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include "sys.h"
#include "error.h"
#include "erl_vm.h"
#include "global.h"
#include "erl_process.h"
#include "bif.h"
#include "big.h"
#include "beam_load.h"
#include "erl_db.h"
#include "hash.h"
#include "erl_bits.h"
#include "erl_binary.h"
#ifdef HIPE
#include <stddef.h>	/* offsetof() */
#include "hipe_arch.h"
#include "hipe_stack.h"
#include "hipe_mode_switch.h"
#include "hipe_native_bif.h"
#include "hipe_bif0.h"
/* We need hipe_literals.h for HIPE_SYSTEM_CRC, but it redefines
   a few constants. #undef them here to avoid warnings. */
#undef F_TIMO
#undef THE_NON_VALUE
#undef ERL_FUN_SIZE
#include "hipe_literals.h"
#endif

#define BeamOpCode(Op)	((Uint)BeamOp(Op))

int term_to_Sint32(Eterm term, Sint *sp)
{
    Sint val;

    if( !term_to_Sint(term, &val) )
	return 0;
    if( (Sint)(Sint32)val != val )
	return 0;
    *sp = val;
    return 1;
}

static Eterm Uint_to_term(Uint x, Process *p)
{
    if( IS_USMALL(0, x) ) {
	return make_small(x);
    } else {
	Eterm *hp = HAlloc(p, BIG_NEED_SIZE(2));
	return uint_to_big(x, hp);
    }
}

void *term_to_address(Eterm arg)
{
    Uint u;
    return term_to_Uint(arg, &u) ? (void*)u : NULL;
}

static Eterm address_to_term(const void *address, Process *p)
{
    return Uint_to_term((Uint)address, p);
}

/*
 * BIFs for reading and writing memory. Used internally by HiPE.
 */
#if 0 /* XXX: unused */
BIF_RETTYPE hipe_bifs_read_u8_1(BIF_ALIST_1)
{
    unsigned char *address = term_to_address(BIF_ARG_1);
    if( !address )
	BIF_ERROR(BIF_P, BADARG);
    BIF_RET(make_small(*address));
}
#endif

#if 0 /* XXX: unused */
BIF_RETTYPE hipe_bifs_read_u32_1(BIF_ALIST_1)
{
    Uint32 *address = term_to_address(BIF_ARG_1);
    if( !address || !hipe_word32_address_ok(address) )
	BIF_ERROR(BIF_P, BADARG);
    BIF_RET(Uint_to_term(*address, BIF_P));
}
#endif

BIF_RETTYPE hipe_bifs_write_u8_2(BIF_ALIST_2)
{
    unsigned char *address;

    address = term_to_address(BIF_ARG_1);
    if( !address || is_not_small(BIF_ARG_2) )
	BIF_ERROR(BIF_P, BADARG);
    *address = unsigned_val(BIF_ARG_2);
    BIF_RET(NIL);
}

#if 0 /* XXX: unused */
BIF_RETTYPE hipe_bifs_write_s32_2(BIF_ALIST_2)
{
    Sint32 *address;
    Sint value;

    address = term_to_address(BIF_ARG_1);
    if( !address || !hipe_word32_address_ok(address) )
	BIF_ERROR(BIF_P, BADARG);
    if( !term_to_Sint32(BIF_ARG_2, &value) )
	BIF_ERROR(BIF_P, BADARG);
    *address = value;
    BIF_RET(NIL);
}
#endif

BIF_RETTYPE hipe_bifs_write_u32_2(BIF_ALIST_2)
{
    Uint32 *address;
    Uint value;

    address = term_to_address(BIF_ARG_1);
    if( !address || !hipe_word32_address_ok(address) )
	BIF_ERROR(BIF_P, BADARG);
    if( !term_to_Uint(BIF_ARG_2, &value) )
	BIF_ERROR(BIF_P, BADARG);
    if( (Uint)(Uint32)value != value )
	BIF_ERROR(BIF_P, BADARG);
    *address = value;
    hipe_flush_icache_word(address);
    BIF_RET(NIL);
}

/*
 * BIFs for mutable bytearrays.
 */
BIF_RETTYPE hipe_bifs_bytearray_2(BIF_ALIST_2)
{
    Sint nelts;
    Eterm bin;

    if (is_not_small(BIF_ARG_1) ||
	(nelts = signed_val(BIF_ARG_1)) < 0 ||
	!is_byte(BIF_ARG_2))
	BIF_ERROR(BIF_P, BADARG);
    bin = new_binary(BIF_P, NULL, nelts);
    memset(binary_bytes(bin), unsigned_val(BIF_ARG_2), nelts);
    BIF_RET(bin);
}

static inline unsigned char *bytearray_lvalue(Eterm bin, Eterm idx)
{
    Sint i;
    unsigned char *bytes;
    Uint bitoffs;
    Uint bitsize;

    if (is_not_binary(bin) ||
	is_not_small(idx) ||
	(i = unsigned_val(idx)) >= binary_size(bin))
	return NULL;
    ERTS_GET_BINARY_BYTES(bin, bytes, bitoffs, bitsize);
    ASSERT(bitoffs == 0);
    ASSERT(bitsize == 0);
    return bytes + i;
}

BIF_RETTYPE hipe_bifs_bytearray_sub_2(BIF_ALIST_2)
{
    unsigned char *bytep;

    bytep = bytearray_lvalue(BIF_ARG_1, BIF_ARG_2);
    if (!bytep)
	BIF_ERROR(BIF_P, BADARG);
    BIF_RET(make_small(*bytep));
}

BIF_RETTYPE hipe_bifs_bytearray_update_3(BIF_ALIST_3)
{
    unsigned char *bytep;

    bytep = bytearray_lvalue(BIF_ARG_1, BIF_ARG_2);
    if (!bytep || !is_byte(BIF_ARG_3))
	BIF_ERROR(BIF_P, BADARG);
    *bytep = unsigned_val(BIF_ARG_3);
    BIF_RET(NIL);
}

/*
 * BIFs for SML-like mutable arrays and reference cells.
 * For now, limited to containing immediate data.
 */
#if 1	/* use bignums as carriers, easier on the gc */
#define make_array_header(sz)	make_pos_bignum_header((sz))
#define array_header_arity(h)	header_arity((h))
#define make_array(hp)		make_big((hp))
#define is_not_array(x)		is_not_big((x))
#define array_val(x)		big_val((x))
#else	/* use tuples as carriers, easier debugging, harder on the gc */
#define make_array_header(sz)	make_arityval((sz))
#define array_header_arity(h)	arityval((h))
#define make_array(hp)		make_tuple((hp))
#define is_not_array(x)		is_not_tuple((x))
#define array_val(x)		tuple_val((x))
#endif
#define array_length(a)		array_header_arity(array_val((a))[0])

BIF_RETTYPE hipe_bifs_array_2(BIF_ALIST_2)
{
    Eterm *hp;
    Sint nelts, i;

    if( is_not_small(BIF_ARG_1) ||
	(nelts = signed_val(BIF_ARG_1)) < 0 ||
	is_not_immed(BIF_ARG_2) )
	BIF_ERROR(BIF_P, BADARG);
    if( nelts == 0 )	/* bignums must not be empty */
	BIF_RET(NIL);
    hp = HAlloc(BIF_P, 1+nelts);
    hp[0] = make_array_header(nelts);
    for(i = 1; i <= nelts; ++i)
	hp[i] = BIF_ARG_2;
    BIF_RET(make_array(hp));
}

BIF_RETTYPE hipe_bifs_array_length_1(BIF_ALIST_1)
{
    if( is_not_array(BIF_ARG_1) ) {
	if( is_nil(BIF_ARG_1) )	/* NIL represents empty arrays */
	    BIF_RET(make_small(0));
	BIF_ERROR(BIF_P, BADARG);
    }
    BIF_RET(make_small(array_header_arity(array_val(BIF_ARG_1)[0])));
}

BIF_RETTYPE hipe_bifs_array_sub_2(BIF_ALIST_2)
{
    Uint i;

    if( is_not_small(BIF_ARG_2) ||
	is_not_array(BIF_ARG_1) ||
	(i = unsigned_val(BIF_ARG_2)) >= array_length(BIF_ARG_1) )
	BIF_ERROR(BIF_P, BADARG);
    BIF_RET(array_val(BIF_ARG_1)[i+1]);
}

BIF_RETTYPE hipe_bifs_array_update_3(BIF_ALIST_3)
{
    Uint i;

    if( is_not_immed(BIF_ARG_3) ||
	is_not_small(BIF_ARG_2) ||
	is_not_array(BIF_ARG_1) ||
	(i = unsigned_val(BIF_ARG_2)) >= array_length(BIF_ARG_1) )
	BIF_ERROR(BIF_P, BADARG);
    array_val(BIF_ARG_1)[i+1] = BIF_ARG_3;
    BIF_RET(NIL);
}

BIF_RETTYPE hipe_bifs_ref_1(BIF_ALIST_1)
{
    Eterm *hp;

    if( is_not_immed(BIF_ARG_1) )
	BIF_RET(BADARG);
    hp = HAlloc(BIF_P, 1+1);
    hp[0] = make_array_header(1);
    hp[1] = BIF_ARG_1;
    BIF_RET(make_array(hp));
}

BIF_RETTYPE hipe_bifs_ref_get_1(BIF_ALIST_1)
{
    if( is_not_array(BIF_ARG_1) ||
	array_val(BIF_ARG_1)[0] != make_array_header(1) )
	BIF_ERROR(BIF_P, BADARG);
    BIF_RET(array_val(BIF_ARG_1)[1]);
}

BIF_RETTYPE hipe_bifs_ref_set_2(BIF_ALIST_2)
{
    if( is_not_immed(BIF_ARG_2) ||
	is_not_array(BIF_ARG_1) ||
	array_val(BIF_ARG_1)[0] != make_array_header(1) )
	BIF_ERROR(BIF_P, BADARG);
    array_val(BIF_ARG_1)[1] = BIF_ARG_2;
    BIF_RET(NIL);
}

/*
 * Allocate memory and copy machine code to it.
 */
BIF_RETTYPE hipe_bifs_enter_code_2(BIF_ALIST_2)
{
    Uint nrbytes;
    void *bytes;
    void *address;
    Uint bitoffs;
    Uint bitsize;
    Eterm trampolines;
    Eterm *hp;

    if( is_not_binary(BIF_ARG_1) )
	BIF_ERROR(BIF_P, BADARG);
    nrbytes = binary_size(BIF_ARG_1);
    ERTS_GET_BINARY_BYTES(BIF_ARG_1, bytes, bitoffs, bitsize);
    ASSERT(bitoffs == 0);
    ASSERT(bitsize == 0);
    trampolines = NIL;
#ifdef HIPE_ALLOC_CODE
    address = HIPE_ALLOC_CODE(nrbytes, BIF_ARG_2, &trampolines, BIF_P);
    if( !address )
	BIF_ERROR(BIF_P, BADARG);
#else
    if( is_not_nil(BIF_ARG_2) )
	BIF_ERROR(BIF_P, BADARG);
    address = erts_alloc(ERTS_ALC_T_HIPE, nrbytes);
#endif
    memcpy(address, bytes, nrbytes);
    hipe_flush_icache_range(address, nrbytes);
    hp = HAlloc(BIF_P, 3);
    hp[0] = make_arityval(2);
    hp[1] = address_to_term(address, BIF_P);
    hp[2] = trampolines;
    BIF_RET(make_tuple(hp));
}

/*
 * Allocate memory for arbitrary non-Erlang data.
 */
BIF_RETTYPE hipe_bifs_alloc_data_2(BIF_ALIST_2)
{
    Uint align, nrbytes;
    void *block;

    if( is_not_small(BIF_ARG_1) || is_not_small(BIF_ARG_2) ||
	(align = unsigned_val(BIF_ARG_1),
	 align != sizeof(long) && align != sizeof(double)) )
	BIF_ERROR(BIF_P, BADARG);
    nrbytes = unsigned_val(BIF_ARG_2);
    block = erts_alloc(ERTS_ALC_T_HIPE, nrbytes);
    if( (unsigned long)block & (align-1) )
	fprintf(stderr, "Yikes! erts_alloc() returned misaligned address %p\r\n", block);
    BIF_RET(address_to_term(block, BIF_P));
}

/*
 * Memory area for constant Erlang terms.
 *
 * These constants must not be forwarded by the gc.
 * Therefore, the gc needs to be able to distinguish between
 * collectible objects and constants. Unfortunately, an Erlang
 * process' collectible objects are scattered around in two
 * heaps and a list of message buffers, so testing "is X a
 * collectible object?" can be expensive.
 *
 * Instead, constants are placed in a single contiguous area,
 * which allows for an inexpensive "is X a constant?" test.
 *
 * XXX: Allow this area to be grown.
 */

/* not static, needed by garbage collector */
Eterm *hipe_constants_start = NULL;
Eterm *hipe_constants_next = NULL;
static unsigned constants_avail_words = 0;
#define CONSTANTS_BYTES	(1536*1024*sizeof(Eterm))  /* 1.5 M words */

static Eterm *constants_alloc(unsigned nwords)
{
    Eterm *next;

    /* initialise at the first call */
    if( (next = hipe_constants_next) == NULL ) {
	next = (Eterm*)erts_alloc(ERTS_ALC_T_HIPE, CONSTANTS_BYTES);
	hipe_constants_start = next;
	hipe_constants_next = next;
	constants_avail_words = CONSTANTS_BYTES / sizeof(Eterm);
    }
    if( nwords > constants_avail_words ) {
	fprintf(stderr, "Native code constants pool depleted!\r\n");
	/* Must terminate immediately. erl_exit() seems to
	   continue running some code which then SIGSEGVs. */
	exit(1);
    }
    constants_avail_words -= nwords;
    hipe_constants_next = next + nwords;
    return next;
}

BIF_RETTYPE hipe_bifs_constants_size_0(BIF_ALIST_0)
{
    BIF_RET(make_small(hipe_constants_next - hipe_constants_start));
}

/*
 * Merging constant Erlang terms.
 * Uses the constants pool and a hash table of all top-level
 * terms merged so far. (Sub-terms are not merged.)
 */
struct const_term {
    HashBucket bucket;
    Eterm val;		/* tagged pointer to mem[0] */
    Eterm mem[1];	/* variable size */
};

static Hash const_term_table;
static ErlOffHeap const_term_table_off_heap;

static HashValue const_term_hash(void *tmpl)
{
    return make_hash2((Eterm)tmpl);
}

static int const_term_cmp(void *tmpl, void *bucket)
{
    return !eq((Eterm)tmpl, ((struct const_term*)bucket)->val);
}

static void *const_term_alloc(void *tmpl)
{
    Eterm obj;
    Uint size;
    Eterm *hp;
    struct const_term *p;

    obj = (Eterm)tmpl;
    ASSERT(is_not_immed(obj));
    size = size_object(obj);

    p = (struct const_term*)constants_alloc(size + (offsetof(struct const_term, mem)/sizeof(Eterm)));

    /* I have absolutely no idea if having a private 'off_heap'
       works or not. _Some_ off_heap object is required for
       REFC_BINARY and FUN values, but _where_ it should be is
       a complete mystery to me. */
    hp = &p->mem[0];
    p->val = copy_struct(obj, size, &hp, &const_term_table_off_heap);

    return &p->bucket;
}

static void init_const_term_table(void)
{
    HashFunctions f;
    f.hash = (H_FUN) const_term_hash;
    f.cmp = (HCMP_FUN) const_term_cmp;
    f.alloc = (HALLOC_FUN) const_term_alloc;
    f.free = (HFREE_FUN) NULL;
    hash_init(ERTS_ALC_T_HIPE, &const_term_table, "const_term_table", 97, f);
}

BIF_RETTYPE hipe_bifs_merge_term_1(BIF_ALIST_1)
{
    static int init_done = 0;
    struct const_term *p;
    Eterm val;

    val = BIF_ARG_1;
    if( is_not_immed(val) ) {
	if( !init_done ) {
	    init_const_term_table();
	    init_done = 1;
	}
	p = (struct const_term*)hash_put(&const_term_table, (void*)val);
	val = p->val;
    }
    BIF_RET(val);
}

struct mfa {
    Eterm mod;
    Eterm fun;
    Uint  ari;
};

static int term_to_mfa(Eterm term, struct mfa *mfa)
{
    Eterm mod, fun, a;
    Uint ari;

    if (is_not_tuple(term))
	return 0;
    if (tuple_val(term)[0] != make_arityval(3))
	return 0;
    mod = tuple_val(term)[1];
    if (is_not_atom(mod))
	return 0;
    mfa->mod = mod;
    fun = tuple_val(term)[2];
    if (is_not_atom(fun))
	return 0;
    mfa->fun = fun;
    a = tuple_val(term)[3];
    if (is_not_small(a))
	return 0;
    ari = unsigned_val(a);
    if (ari > 255)
	return 0;
    mfa->ari = ari;
    return 1;
}

#ifdef DEBUG_LINKER
static void print_mfa(Eterm mod, Eterm fun, unsigned int ari)
{
    erts_printf("%T:%T/%u", mod, fun, ari);
}
#endif

/*
 * Convert {M,F,A} to pointer to first insn after initial func_info.
 */
static Uint *hipe_find_emu_address(Eterm mod, Eterm name, unsigned int arity)
{
    Module *modp;
    Uint *code_base;
    int i, n;

    modp = erts_get_module(mod);
    if( modp == NULL || (code_base = modp->code) == NULL )
	return NULL;
    n = code_base[MI_NUM_FUNCTIONS];
    for(i = 0; i < n; ++i) {
	Uint *code_ptr = (Uint*)code_base[MI_FUNCTIONS+i];
	ASSERT(code_ptr[0] == BeamOpCode(op_i_func_info_IaaI));
	if( code_ptr[3] == name && code_ptr[4] == arity )
	    return code_ptr+5;
    }
    return NULL;
}

Uint *hipe_bifs_find_pc_from_mfa(Eterm term)
{
    struct mfa mfa;

    if (!term_to_mfa(term, &mfa))
	return NULL;
    return hipe_find_emu_address(mfa.mod, mfa.fun, mfa.ari);
}

BIF_RETTYPE hipe_bifs_fun_to_address_1(BIF_ALIST_1)
{
    Eterm *pc = hipe_bifs_find_pc_from_mfa(BIF_ARG_1);
    if( !pc )
	BIF_ERROR(BIF_P, BADARG);
    BIF_RET(address_to_term(pc, BIF_P));
}

static void *hipe_get_emu_address(Eterm m, Eterm f, unsigned int arity, int is_remote)
{
    void *address = NULL;
    if (!is_remote)
	address = hipe_find_emu_address(m, f, arity);
    if( !address ) {
	/* if not found, stub it via the export entry */
	Export *export_entry = erts_export_get_or_make_stub(m, f, arity);
	address = export_entry->address;
    }
    return address;
}

#if 0 /* XXX: unused */
BIF_RETTYPE hipe_bifs_get_emu_address_1(BIF_ALIST_1)
{
    struct mfa mfa;
    void *address;

    if (!term_to_mfa(BIF_ARG_1, &mfa))
	BIF_ERROR(BIF_P, BADARG);
    address = hipe_get_emu_address(mfa.mod, mfa.fun, mfa.ari);
    BIF_RET(address_to_term(address, BIF_P));
}
#endif

BIF_RETTYPE hipe_bifs_set_native_address_3(BIF_ALIST_3)
{
    Eterm *pc;
    void *address;
    int is_closure;
    struct mfa mfa;

    switch( BIF_ARG_3 ) {
      case am_false:
	is_closure = 0;
	break;
      case am_true:
	is_closure = 1;
	break;
      default:
	BIF_ERROR(BIF_P, BADARG);
    }
    address = term_to_address(BIF_ARG_2);
    if( !address )
	BIF_ERROR(BIF_P, BADARG);

    /* The mfa is needed again later, otherwise we could
       simply have called hipe_bifs_find_pc_from_mfa(). */
    if (!term_to_mfa(BIF_ARG_1, &mfa))
	BIF_ERROR(BIF_P, BADARG);
    pc = hipe_find_emu_address(mfa.mod, mfa.fun, mfa.ari);

    if( pc ) {
	hipe_mfa_save_orig_beam_op(mfa.mod, mfa.fun, mfa.ari, pc);
#if HIPE
#ifdef DEBUG_LINKER
	printf("%s: ", __FUNCTION__);
	print_mfa(mfa.mod, mfa.fun, mfa.ari);
	printf(": planting call trap to %p at BEAM pc %p\r\n", address, pc);
#endif