static int
any_heap_refs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size)
{
Eterm* p;
Eterm val;
for (p = start; p < end; p++) {
val = *p;
switch (primary_tag(val)) {
case TAG_PRIMARY_BOXED:
case TAG_PRIMARY_LIST:
if (in_area(val, mod_start, mod_size)) {
return 1;
}
break;
case TAG_PRIMARY_HEADER:
if (!header_is_transparent(val)) {
Eterm* new_p = p + thing_arityval(val);
ASSERT(start <= new_p && new_p < end);
p = new_p;
}
}
}
return 0;
}
static int
any_heap_ref_ptrs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size)
{
Eterm* p;
Eterm val;
for (p = start; p < end; p++) {
val = *p;
switch (primary_tag(val)) {
case TAG_PRIMARY_BOXED:
case TAG_PRIMARY_LIST:
if (in_area(val, mod_start, mod_size)) {
return 1;
}
break;
}
}
return 0;
}
static Eterm
http_bld_string(struct packet_callback_args* pca, Uint **hpp, Uint *szp,
const char *str, Sint len)
{
Eterm res = THE_NON_VALUE;
Uint size;
int make_subbin;
if (pca->string_as_bin) {
size = heap_bin_size(len);
make_subbin = (size > ERL_SUB_BIN_SIZE
&& in_area(str, pca->aligned_ptr, pca->bin_sz));
if (szp) {
*szp += make_subbin ? ERL_SUB_BIN_SIZE : size;
}
if (hpp) {
res = make_binary(*hpp);
if (make_subbin) {
ErlSubBin* bin = (ErlSubBin*) *hpp;
bin->thing_word = HEADER_SUB_BIN;
bin->size = len;
bin->offs = pca->bin_offs + ((byte*)str - pca->aligned_ptr);
bin->orig = pca->orig;
bin->bitoffs = pca->bin_bitoffs;
bin->bitsize = 0;
bin->is_writable = 0;
*hpp += ERL_SUB_BIN_SIZE;
}
else {
ErlHeapBin* bin = (ErlHeapBin*) *hpp;
bin->thing_word = header_heap_bin(len);
bin->size = len;
memcpy(bin->data, str, len);
*hpp += size;
}
}
}
else {
res = erts_bld_string_n(hpp, szp, str, len);
}
return res;
}
BIF_RETTYPE load_nif_2(BIF_ALIST_2)
{
static const char bad_lib[] = "bad_lib";
static const char reload[] = "reload";
static const char upgrade[] = "upgrade";
char* lib_name = NULL;
void* handle = NULL;
void* init_func;
ErlNifEntry* entry = NULL;
ErlNifEnv env;
int len, i, err;
Module* mod;
Eterm mod_atom;
Eterm f_atom;
BeamInstr* caller;
ErtsSysDdllError errdesc = ERTS_SYS_DDLL_ERROR_INIT;
Eterm ret = am_ok;
int veto;
struct erl_module_nif* lib = NULL;
len = list_length(BIF_ARG_1);
if (len < 0) {
BIF_ERROR(BIF_P, BADARG);
}
lib_name = (char *) erts_alloc(ERTS_ALC_T_TMP, len + 1);
if (intlist_to_buf(BIF_ARG_1, lib_name, len) != len) {
erts_free(ERTS_ALC_T_TMP, lib_name);
BIF_ERROR(BIF_P, BADARG);
}
lib_name[len] = '\0';
/* Block system (is this the right place to do it?) */
erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
erts_smp_thr_progress_block();
/* Find calling module */
ASSERT(BIF_P->current != NULL);
ASSERT(BIF_P->current[0] == am_erlang
&& BIF_P->current[1] == am_load_nif
&& BIF_P->current[2] == 2);
caller = find_function_from_pc(BIF_P->cp);
ASSERT(caller != NULL);
mod_atom = caller[0];
ASSERT(is_atom(mod_atom));
mod=erts_get_module(mod_atom);
ASSERT(mod != NULL);
if (!in_area(caller, mod->code, mod->code_length)) {
ASSERT(in_area(caller, mod->old_code, mod->old_code_length));
ret = load_nif_error(BIF_P, "old_code", "Calling load_nif from old "
"module '%T' not allowed", mod_atom);
}
else if ((err=erts_sys_ddll_open2(lib_name, &handle, &errdesc)) != ERL_DE_NO_ERROR) {
const char slogan[] = "Failed to load NIF library";
if (strstr(errdesc.str, lib_name) != NULL) {
ret = load_nif_error(BIF_P, "load_failed", "%s: '%s'", slogan, errdesc.str);
}
else {
ret = load_nif_error(BIF_P, "load_failed", "%s %s: '%s'", slogan, lib_name, errdesc.str);
}
}
else if (erts_sys_ddll_load_nif_init(handle, &init_func, &errdesc) != ERL_DE_NO_ERROR) {
ret = load_nif_error(BIF_P, bad_lib, "Failed to find library init"
" function: '%s'", errdesc.str);
}
else if ((add_taint(mod_atom),
(entry = erts_sys_ddll_call_nif_init(init_func)) == NULL)) {
ret = load_nif_error(BIF_P, bad_lib, "Library init-call unsuccessful");
}
else if (entry->major != ERL_NIF_MAJOR_VERSION
|| entry->minor > ERL_NIF_MINOR_VERSION) {
ret = load_nif_error(BIF_P, bad_lib, "Library version (%d.%d) not compatible (with %d.%d).",
entry->major, entry->minor, ERL_NIF_MAJOR_VERSION, ERL_NIF_MINOR_VERSION);
}
else if (entry->minor >= 1
&& sys_strcmp(entry->vm_variant, ERL_NIF_VM_VARIANT) != 0) {
ret = load_nif_error(BIF_P, bad_lib, "Library (%s) not compiled for "
"this vm variant (%s).",
entry->vm_variant, ERL_NIF_VM_VARIANT);
}
else if (!erts_is_atom_str((char*)entry->name, mod_atom)) {
ret = load_nif_error(BIF_P, bad_lib, "Library module name '%s' does not"
" match calling module '%T'", entry->name, mod_atom);
}
else {
/*erts_fprintf(stderr, "Found module %T\r\n", mod_atom);*/
for (i=0; i < entry->num_of_funcs && ret==am_ok; i++) {
BeamInstr** code_pp;
ErlNifFunc* f = &entry->funcs[i];
if (!erts_atom_get(f->name, sys_strlen(f->name), &f_atom)
|| (code_pp = get_func_pp(mod->code, f_atom, f->arity))==NULL) {
ret = load_nif_error(BIF_P,bad_lib,"Function not found %T:%s/%u",
mod_atom, f->name, f->arity);
}
else if (code_pp[1] - code_pp[0] < (5+3)) {
ret = load_nif_error(BIF_P,bad_lib,"No explicit call to load_nif"
" in module (%T:%s/%u to small)",
mod_atom, entry->funcs[i].name, entry->funcs[i].arity);
}
/*erts_fprintf(stderr, "Found NIF %T:%s/%u\r\n",
mod_atom, entry->funcs[i].name, entry->funcs[i].arity);*/
}
}
if (ret != am_ok) {
goto error;
}
/* Call load, reload or upgrade:
*/
lib = erts_alloc(ERTS_ALC_T_NIF, sizeof(struct erl_module_nif));
lib->handle = handle;
lib->entry = entry;
erts_refc_init(&lib->rt_cnt, 0);
erts_refc_init(&lib->rt_dtor_cnt, 0);
lib->mod = mod;
env.mod_nif = lib;
if (mod->nif != NULL) { /* Reload */
int k;
lib->priv_data = mod->nif->priv_data;
ASSERT(mod->nif->entry != NULL);
if (entry->reload == NULL) {
ret = load_nif_error(BIF_P,reload,"Reload not supported by this NIF library.");
goto error;
}
/* Check that no NIF is removed */
for (k=0; k < mod->nif->entry->num_of_funcs; k++) {
ErlNifFunc* old_func = &mod->nif->entry->funcs[k];
for (i=0; i < entry->num_of_funcs; i++) {
if (old_func->arity == entry->funcs[i].arity
&& sys_strcmp(old_func->name, entry->funcs[i].name) == 0) {
break;
}
}
if (i == entry->num_of_funcs) {
ret = load_nif_error(BIF_P,reload,"Reloaded library missing "
"function %T:%s/%u\r\n", mod_atom,
old_func->name, old_func->arity);
goto error;
}
}
erts_pre_nif(&env, BIF_P, lib);
veto = entry->reload(&env, &lib->priv_data, BIF_ARG_2);
erts_post_nif(&env);
if (veto) {
ret = load_nif_error(BIF_P, reload, "Library reload-call unsuccessful.");
}
else {
mod->nif->entry = NULL; /* to prevent 'unload' callback */
erts_unload_nif(mod->nif);
}
}
else {
lib->priv_data = NULL;
if (mod->old_nif != NULL) { /* Upgrade */
void* prev_old_data = mod->old_nif->priv_data;
if (entry->upgrade == NULL) {
ret = load_nif_error(BIF_P, upgrade, "Upgrade not supported by this NIF library.");
goto error;
}
erts_pre_nif(&env, BIF_P, lib);
veto = entry->upgrade(&env, &lib->priv_data, &mod->old_nif->priv_data, BIF_ARG_2);
erts_post_nif(&env);
if (veto) {
mod->old_nif->priv_data = prev_old_data;
ret = load_nif_error(BIF_P, upgrade, "Library upgrade-call unsuccessful.");
}
/*else if (mod->old_nif->priv_data != prev_old_data) {
refresh_cached_nif_data(mod->old_code, mod->old_nif);
}*/
}
else if (entry->load != NULL) { /* Initial load */
erts_pre_nif(&env, BIF_P, lib);
veto = entry->load(&env, &lib->priv_data, BIF_ARG_2);
erts_post_nif(&env);
if (veto) {
ret = load_nif_error(BIF_P, "load", "Library load-call unsuccessful.");
}
}
}
if (ret == am_ok) {
/*
** Everything ok, patch the beam code with op_call_nif
*/
mod->nif = lib;
for (i=0; i < entry->num_of_funcs; i++)
{
BeamInstr* code_ptr;
erts_atom_get(entry->funcs[i].name, sys_strlen(entry->funcs[i].name), &f_atom);
code_ptr = *get_func_pp(mod->code, f_atom, entry->funcs[i].arity);
if (code_ptr[1] == 0) {
code_ptr[5+0] = (BeamInstr) BeamOp(op_call_nif);
}
else { /* Function traced, patch the original instruction word */
BpData** bps = (BpData**) code_ptr[1];
BpData* bp = (BpData*) bps[erts_bp_sched2ix()];
bp->orig_instr = (BeamInstr) BeamOp(op_call_nif);
}
code_ptr[5+1] = (BeamInstr) entry->funcs[i].fptr;
code_ptr[5+2] = (BeamInstr) lib;
}
}
else {
error:
ASSERT(ret != am_ok);
if (lib != NULL) {
erts_free(ERTS_ALC_T_NIF, lib);
}
if (handle != NULL) {
erts_sys_ddll_close(handle);
}
erts_sys_ddll_free_error(&errdesc);
}
erts_smp_thr_progress_unblock();
erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN);
erts_free(ERTS_ALC_T_TMP, lib_name);
BIF_RET(ret);
}
/*
* Copy a structure to a heap.
*/
Eterm
copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
{
char* hstart;
Uint hsize;
Eterm* htop;
Eterm* hbot;
Eterm* hp;
Eterm* objp;
Eterm* tp;
Eterm res;
Eterm elem;
Eterm* tailp;
Eterm* argp;
Eterm* const_tuple;
Eterm hdr;
int i;
#ifdef DEBUG
Eterm org_obj = obj;
Uint org_sz = sz;
#endif
if (IS_CONST(obj))
return obj;
hp = htop = *hpp;
hbot = htop + sz;
hstart = (char *)htop;
hsize = (char*) hbot - hstart;
const_tuple = 0;
/* Copy the object onto the heap */
switch (primary_tag(obj)) {
case TAG_PRIMARY_LIST: argp = &res; goto L_copy_list;
case TAG_PRIMARY_BOXED: argp = &res; goto L_copy_boxed;
default:
erl_exit(ERTS_ABORT_EXIT,
"%s, line %d: Internal error in copy_struct: 0x%08x\n",
__FILE__, __LINE__,obj);
}
L_copy:
while (hp != htop) {
obj = *hp;
switch (primary_tag(obj)) {
case TAG_PRIMARY_IMMED1:
hp++;
break;
case TAG_PRIMARY_LIST:
objp = list_val(obj);
if (in_area(objp,hstart,hsize)) {
hp++;
break;
}
argp = hp++;
/* Fall through */
L_copy_list:
tailp = argp;
while (is_list(obj)) {
objp = list_val(obj);
tp = tailp;
elem = *objp;
if (IS_CONST(elem)) {
*(hbot-2) = elem;
tailp = hbot-1;
hbot -= 2;
}
else {
*htop = elem;
tailp = htop+1;
htop += 2;
}
*tp = make_list(tailp - 1);
obj = *(objp+1);
}
switch (primary_tag(obj)) {
case TAG_PRIMARY_IMMED1: *tailp = obj; goto L_copy;
case TAG_PRIMARY_BOXED: argp = tailp; goto L_copy_boxed;
default:
erl_exit(ERTS_ABORT_EXIT,
"%s, line %d: Internal error in copy_struct: 0x%08x\n",
__FILE__, __LINE__,obj);
}
case TAG_PRIMARY_BOXED:
if (in_area(boxed_val(obj),hstart,hsize)) {
hp++;
break;
}
argp = hp++;
L_copy_boxed:
objp = boxed_val(obj);
hdr = *objp;
switch (hdr & _TAG_HEADER_MASK) {
case ARITYVAL_SUBTAG:
{
int const_flag = 1; /* assume constant tuple */
i = arityval(hdr);
*argp = make_tuple(htop);
tp = htop; /* tp is pointer to new arity value */
*htop++ = *objp++; /* copy arity value */
while (i--) {
elem = *objp++;
if (!IS_CONST(elem)) {
const_flag = 0;
}
*htop++ = elem;
}
if (const_flag) {
const_tuple = tp; /* this is the latest const_tuple */
}
}
break;
case REFC_BINARY_SUBTAG:
{
ProcBin* pb;
pb = (ProcBin *) objp;
if (pb->flags) {
erts_emasculate_writable_binary(pb);
}
i = thing_arityval(*objp) + 1;
hbot -= i;
tp = hbot;
while (i--) {
*tp++ = *objp++;
}
*argp = make_binary(hbot);
pb = (ProcBin*) hbot;
erts_refc_inc(&pb->val->refc, 2);
pb->next = off_heap->mso;
pb->flags = 0;
off_heap->mso = pb;
off_heap->overhead += pb->size / sizeof(Eterm);
}
break;
case SUB_BINARY_SUBTAG:
{
ErlSubBin* sb = (ErlSubBin *) objp;
Eterm real_bin = sb->orig;
Uint bit_offset = sb->bitoffs;
Uint bit_size = sb -> bitsize;
Uint offset = sb->offs;
size_t size = sb->size;
Uint extra_bytes;
Uint real_size;
if ((bit_size + bit_offset) > 8) {
extra_bytes = 2;
} else if ((bit_size + bit_offset) > 0) {
extra_bytes = 1;
} else {
extra_bytes = 0;
}
real_size = size+extra_bytes;
objp = binary_val(real_bin);
if (thing_subtag(*objp) == HEAP_BINARY_SUBTAG) {
ErlHeapBin* from = (ErlHeapBin *) objp;
ErlHeapBin* to;
i = heap_bin_size(real_size);
hbot -= i;
to = (ErlHeapBin *) hbot;
to->thing_word = header_heap_bin(real_size);
to->size = real_size;
sys_memcpy(to->data, ((byte *)from->data)+offset, real_size);
} else {
ProcBin* from = (ProcBin *) objp;
ProcBin* to;
ASSERT(thing_subtag(*objp) == REFC_BINARY_SUBTAG);
if (from->flags) {
erts_emasculate_writable_binary(from);
}
hbot -= PROC_BIN_SIZE;
to = (ProcBin *) hbot;
to->thing_word = HEADER_PROC_BIN;
to->size = real_size;
to->val = from->val;
erts_refc_inc(&to->val->refc, 2);
to->bytes = from->bytes + offset;
to->next = off_heap->mso;
to->flags = 0;
off_heap->mso = to;
off_heap->overhead += to->size / sizeof(Eterm);
}
*argp = make_binary(hbot);
if (extra_bytes != 0) {
ErlSubBin* res;
hbot -= ERL_SUB_BIN_SIZE;
res = (ErlSubBin *) hbot;
res->thing_word = HEADER_SUB_BIN;
res->size = size;
res->bitsize = bit_size;
res->bitoffs = bit_offset;
res->offs = 0;
res->is_writable = 0;
res->orig = *argp;
*argp = make_binary(hbot);
}
break;
}
break;
case FUN_SUBTAG:
{
ErlFunThing* funp = (ErlFunThing *) objp;
i = thing_arityval(hdr) + 2 + funp->num_free;
tp = htop;
while (i--) {
*htop++ = *objp++;
}
#ifndef HYBRID /* FIND ME! */
funp = (ErlFunThing *) tp;
funp->next = off_heap->funs;
off_heap->funs = funp;
erts_refc_inc(&funp->fe->refc, 2);
#endif
*argp = make_fun(tp);
}
break;
case EXTERNAL_PID_SUBTAG:
case EXTERNAL_PORT_SUBTAG:
case EXTERNAL_REF_SUBTAG:
{
ExternalThing *etp = (ExternalThing *) htop;
i = thing_arityval(hdr) + 1;
tp = htop;
while (i--) {
*htop++ = *objp++;
}
etp->next = off_heap->externals;
off_heap->externals = etp;
erts_refc_inc(&etp->node->refc, 2);
*argp = make_external(tp);
}
break;
case BIN_MATCHSTATE_SUBTAG:
erl_exit(ERTS_ABORT_EXIT,
"copy_struct: matchstate term not allowed");
default:
i = thing_arityval(hdr)+1;
hbot -= i;
tp = hbot;
*argp = make_boxed(hbot);
while (i--) {
*tp++ = *objp++;
}
}
break;
case TAG_PRIMARY_HEADER:
if (header_is_thing(obj) || hp == const_tuple) {
hp += header_arity(obj) + 1;
} else {
hp++;
}
break;
}
}
#ifdef DEBUG
if (htop != hbot)
erl_exit(ERTS_ABORT_EXIT,
"Internal error in copy_struct() when copying %T:"
" htop=%p != hbot=%p (sz=%bpu)\n",
org_obj, htop, hbot, org_sz);
#else
if (htop > hbot) {
erl_exit(ERTS_ABORT_EXIT,
"Internal error in copy_struct(): htop, hbot overrun\n");
}
#endif
*hpp = (Eterm *) (hstart+hsize);
return res;
}
Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
#endif
{
char* hstart;
Uint hsize;
Eterm* htop;
Eterm* hbot;
Eterm* hp;
Eterm* objp;
Eterm* tp;
Eterm res;
Eterm elem;
Eterm* tailp;
Eterm* argp;
Eterm* const_tuple;
Eterm hdr;
int i;
#ifdef DEBUG
Eterm org_obj = obj;
Uint org_sz = sz;
#endif
if (IS_CONST(obj))
return obj;
DTRACE1(copy_struct, (int32_t)sz);
hp = htop = *hpp;
hbot = htop + sz;
hstart = (char *)htop;
hsize = (char*) hbot - hstart;
const_tuple = 0;
/* Copy the object onto the heap */
switch (primary_tag(obj)) {
case TAG_PRIMARY_LIST:
argp = &res;
objp = list_val_rel(obj,src_base);
goto L_copy_list;
case TAG_PRIMARY_BOXED: argp = &res; goto L_copy_boxed;
default:
erl_exit(ERTS_ABORT_EXIT,
"%s, line %d: Internal error in copy_struct: 0x%08x\n",
__FILE__, __LINE__,obj);
}
L_copy:
while (hp != htop) {
obj = *hp;
switch (primary_tag(obj)) {
case TAG_PRIMARY_IMMED1:
hp++;
break;
case TAG_PRIMARY_LIST:
objp = list_val_rel(obj,src_base);
#if !HALFWORD_HEAP || defined(DEBUG)
if (in_area(objp,hstart,hsize)) {
ASSERT(!HALFWORD_HEAP);
hp++;
break;
}
#endif
argp = hp++;
/* Fall through */
L_copy_list:
tailp = argp;
for (;;) {
tp = tailp;
elem = CAR(objp);
if (IS_CONST(elem)) {
hbot -= 2;
CAR(hbot) = elem;
tailp = &CDR(hbot);
}
else {
CAR(htop) = elem;
#if HALFWORD_HEAP
CDR(htop) = CDR(objp);
*tailp = make_list_rel(htop,dst_base);
htop += 2;
goto L_copy;
#else
tailp = &CDR(htop);
htop += 2;
#endif
}
ASSERT(!HALFWORD_HEAP || tp < hp || tp >= hbot);
*tp = make_list_rel(tailp - 1, dst_base);
obj = CDR(objp);
if (!is_list(obj)) {
break;
}
objp = list_val_rel(obj,src_base);
}
switch (primary_tag(obj)) {
case TAG_PRIMARY_IMMED1: *tailp = obj; goto L_copy;
case TAG_PRIMARY_BOXED: argp = tailp; goto L_copy_boxed;
default:
erl_exit(ERTS_ABORT_EXIT,
"%s, line %d: Internal error in copy_struct: 0x%08x\n",
__FILE__, __LINE__,obj);
}
case TAG_PRIMARY_BOXED:
#if !HALFWORD_HEAP || defined(DEBUG)
if (in_area(boxed_val_rel(obj,src_base),hstart,hsize)) {
ASSERT(!HALFWORD_HEAP);
hp++;
break;
}
#endif
argp = hp++;
L_copy_boxed:
objp = boxed_val_rel(obj, src_base);
hdr = *objp;
switch (hdr & _TAG_HEADER_MASK) {
case ARITYVAL_SUBTAG:
{
int const_flag = 1; /* assume constant tuple */
i = arityval(hdr);
*argp = make_tuple_rel(htop, dst_base);
tp = htop; /* tp is pointer to new arity value */
*htop++ = *objp++; /* copy arity value */
while (i--) {
elem = *objp++;
if (!IS_CONST(elem)) {
const_flag = 0;
}
*htop++ = elem;
}
if (const_flag) {
const_tuple = tp; /* this is the latest const_tuple */
}
}
break;
case MAP_SUBTAG:
{
i = map_get_size(objp) + 3;
*argp = make_map_rel(htop, dst_base);
while (i--) {
*htop++ = *objp++;
}
}
break;
case REFC_BINARY_SUBTAG:
{
EPIPHANY_STUB(copy_struct);
}
break;
case SUB_BINARY_SUBTAG:
{
EPIPHANY_STUB(copy_struct);
}
break;
case FUN_SUBTAG:
{
ErlFunThing* funp = (ErlFunThing *) objp;
i = thing_arityval(hdr) + 2 + funp->num_free;
tp = htop;
while (i--) {
*htop++ = *objp++;
}
funp = (ErlFunThing *) tp;
funp->next = off_heap->first;
off_heap->first = (struct erl_off_heap_header*) funp;
erts_refc_inc(&funp->fe->refc, 2);
*argp = make_fun_rel(tp, dst_base);
}
break;
case EXTERNAL_PID_SUBTAG:
case EXTERNAL_PORT_SUBTAG:
case EXTERNAL_REF_SUBTAG:
{
ExternalThing *etp = (ExternalThing *) htop;
i = thing_arityval(hdr) + 1;
tp = htop;
while (i--) {
*htop++ = *objp++;
}
etp->next = off_heap->first;
off_heap->first = (struct erl_off_heap_header*)etp;
erts_refc_inc(&etp->node->refc, 2);
*argp = make_external_rel(tp, dst_base);
}
break;
case BIN_MATCHSTATE_SUBTAG:
erl_exit(ERTS_ABORT_EXIT,
"copy_struct: matchstate term not allowed");
default:
i = thing_arityval(hdr)+1;
hbot -= i;
tp = hbot;
*argp = make_boxed_rel(hbot, dst_base);
while (i--) {
*tp++ = *objp++;
}
}
break;
case TAG_PRIMARY_HEADER:
if (header_is_thing(obj) || hp == const_tuple) {
hp += header_arity(obj) + 1;
} else {
hp++;
}
break;
}
}
#ifdef DEBUG
if (htop != hbot)
erl_exit(ERTS_ABORT_EXIT,
"Internal error in copy_struct() when copying %T:"
" htop=%p != hbot=%p (sz=%beu)\n",
org_obj, htop, hbot, org_sz);
#else
if (htop > hbot) {
erl_exit(ERTS_ABORT_EXIT,
"Internal error in copy_struct(): htop, hbot overrun\n");
}
#endif
*hpp = (Eterm *) (hstart+hsize);
return res;
}
Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
#endif
{
char* hstart;
Uint hsize;
Eterm* htop;
Eterm* hbot;
Eterm* hp;
Eterm* objp;
Eterm* tp;
Eterm res;
Eterm elem;
Eterm* tailp;
Eterm* argp;
Eterm* const_tuple;
Eterm hdr;
int i;
#ifdef DEBUG
Eterm org_obj = obj;
Uint org_sz = sz;
#endif
if (IS_CONST(obj))
return obj;
DTRACE1(copy_struct, (int32_t)sz);
hp = htop = *hpp;
hbot = htop + sz;
hstart = (char *)htop;
hsize = (char*) hbot - hstart;
const_tuple = 0;
/* Copy the object onto the heap */
switch (primary_tag(obj)) {
case TAG_PRIMARY_LIST:
argp = &res;
objp = list_val_rel(obj,src_base);
goto L_copy_list;
case TAG_PRIMARY_BOXED: argp = &res; goto L_copy_boxed;
default:
erl_exit(ERTS_ABORT_EXIT,
"%s, line %d: Internal error in copy_struct: 0x%08x\n",
__FILE__, __LINE__,obj);
}
L_copy:
while (hp != htop) {
obj = *hp;
switch (primary_tag(obj)) {
case TAG_PRIMARY_IMMED1:
hp++;
break;
case TAG_PRIMARY_LIST:
objp = list_val_rel(obj,src_base);
#if !HALFWORD_HEAP || defined(DEBUG)
if (in_area(objp,hstart,hsize)) {
ASSERT(!HALFWORD_HEAP);
hp++;
break;
}
#endif
argp = hp++;
/* Fall through */
L_copy_list:
tailp = argp;
for (;;) {
tp = tailp;
elem = CAR(objp);
if (IS_CONST(elem)) {
hbot -= 2;
CAR(hbot) = elem;
tailp = &CDR(hbot);
}
else {
CAR(htop) = elem;
#if HALFWORD_HEAP
CDR(htop) = CDR(objp);
*tailp = make_list_rel(htop,dst_base);
htop += 2;
goto L_copy;
#else
tailp = &CDR(htop);
htop += 2;
#endif
}
ASSERT(!HALFWORD_HEAP || tp < hp || tp >= hbot);
*tp = make_list_rel(tailp - 1, dst_base);
obj = CDR(objp);
if (!is_list(obj)) {
break;
}
objp = list_val_rel(obj,src_base);
}
switch (primary_tag(obj)) {
case TAG_PRIMARY_IMMED1: *tailp = obj; goto L_copy;
case TAG_PRIMARY_BOXED: argp = tailp; goto L_copy_boxed;
default:
erl_exit(ERTS_ABORT_EXIT,
"%s, line %d: Internal error in copy_struct: 0x%08x\n",
__FILE__, __LINE__,obj);
}
case TAG_PRIMARY_BOXED:
#if !HALFWORD_HEAP || defined(DEBUG)
if (in_area(boxed_val_rel(obj,src_base),hstart,hsize)) {
ASSERT(!HALFWORD_HEAP);
hp++;
break;
}
#endif
argp = hp++;
L_copy_boxed:
objp = boxed_val_rel(obj, src_base);
hdr = *objp;
switch (hdr & _TAG_HEADER_MASK) {
case ARITYVAL_SUBTAG:
{
int const_flag = 1; /* assume constant tuple */
i = arityval(hdr);
*argp = make_tuple_rel(htop, dst_base);
tp = htop; /* tp is pointer to new arity value */
*htop++ = *objp++; /* copy arity value */
while (i--) {
elem = *objp++;
if (!IS_CONST(elem)) {
const_flag = 0;
}
*htop++ = elem;
}
if (const_flag) {
const_tuple = tp; /* this is the latest const_tuple */
}
}
break;
case REFC_BINARY_SUBTAG:
{
ProcBin* pb;
pb = (ProcBin *) objp;
if (pb->flags) {
erts_emasculate_writable_binary(pb);
}
i = thing_arityval(*objp) + 1;
hbot -= i;
tp = hbot;
while (i--) {
*tp++ = *objp++;
}
*argp = make_binary_rel(hbot, dst_base);
pb = (ProcBin*) hbot;
erts_refc_inc(&pb->val->refc, 2);
pb->next = off_heap->first;
pb->flags = 0;
off_heap->first = (struct erl_off_heap_header*) pb;
OH_OVERHEAD(off_heap, pb->size / sizeof(Eterm));
}
break;
case SUB_BINARY_SUBTAG:
{
ErlSubBin* sb = (ErlSubBin *) objp;
Eterm real_bin = sb->orig;
Uint bit_offset = sb->bitoffs;
Uint bit_size = sb -> bitsize;
Uint offset = sb->offs;
size_t size = sb->size;
Uint extra_bytes;
Uint real_size;
if ((bit_size + bit_offset) > 8) {
extra_bytes = 2;
} else if ((bit_size + bit_offset) > 0) {
extra_bytes = 1;
} else {
extra_bytes = 0;
}
real_size = size+extra_bytes;
objp = binary_val_rel(real_bin,src_base);
if (thing_subtag(*objp) == HEAP_BINARY_SUBTAG) {
ErlHeapBin* from = (ErlHeapBin *) objp;
ErlHeapBin* to;
i = heap_bin_size(real_size);
hbot -= i;
to = (ErlHeapBin *) hbot;
to->thing_word = header_heap_bin(real_size);
to->size = real_size;
sys_memcpy(to->data, ((byte *)from->data)+offset, real_size);
} else {
ProcBin* from = (ProcBin *) objp;
ProcBin* to;
ASSERT(thing_subtag(*objp) == REFC_BINARY_SUBTAG);
if (from->flags) {
erts_emasculate_writable_binary(from);
}
hbot -= PROC_BIN_SIZE;
to = (ProcBin *) hbot;
to->thing_word = HEADER_PROC_BIN;
to->size = real_size;
to->val = from->val;
erts_refc_inc(&to->val->refc, 2);
to->bytes = from->bytes + offset;
to->next = off_heap->first;
to->flags = 0;
off_heap->first = (struct erl_off_heap_header*) to;
OH_OVERHEAD(off_heap, to->size / sizeof(Eterm));
}
*argp = make_binary_rel(hbot, dst_base);
if (extra_bytes != 0) {
ErlSubBin* res;
hbot -= ERL_SUB_BIN_SIZE;
res = (ErlSubBin *) hbot;
res->thing_word = HEADER_SUB_BIN;
res->size = size;
res->bitsize = bit_size;
res->bitoffs = bit_offset;
res->offs = 0;
res->is_writable = 0;
res->orig = *argp;
*argp = make_binary_rel(hbot, dst_base);
}
break;
}
break;
case FUN_SUBTAG:
{
ErlFunThing* funp = (ErlFunThing *) objp;
i = thing_arityval(hdr) + 2 + funp->num_free;
tp = htop;
while (i--) {
*htop++ = *objp++;
}
funp = (ErlFunThing *) tp;
funp->next = off_heap->first;
off_heap->first = (struct erl_off_heap_header*) funp;
erts_refc_inc(&funp->fe->refc, 2);
*argp = make_fun_rel(tp, dst_base);
}
break;
case EXTERNAL_PID_SUBTAG:
case EXTERNAL_PORT_SUBTAG:
case EXTERNAL_REF_SUBTAG:
{
ExternalThing *etp = (ExternalThing *) htop;
i = thing_arityval(hdr) + 1;
tp = htop;
while (i--) {
*htop++ = *objp++;
}
etp->next = off_heap->first;
off_heap->first = (struct erl_off_heap_header*)etp;
erts_refc_inc(&etp->node->refc, 2);
*argp = make_external_rel(tp, dst_base);
}
break;
case MAP_SUBTAG:
tp = htop;
switch (MAP_HEADER_TYPE(hdr)) {
case MAP_HEADER_TAG_FLATMAP_HEAD :
i = flatmap_get_size(objp) + 3;
*argp = make_flatmap_rel(htop, dst_base);
while (i--) {
*htop++ = *objp++;
}
break;
case MAP_HEADER_TAG_HAMT_HEAD_BITMAP :
case MAP_HEADER_TAG_HAMT_HEAD_ARRAY :
*htop++ = *objp++;
case MAP_HEADER_TAG_HAMT_NODE_BITMAP :
i = 1 + hashmap_bitcount(MAP_HEADER_VAL(hdr));
while (i--) { *htop++ = *objp++; }
*argp = make_hashmap_rel(tp, dst_base);
break;
default:
erl_exit(ERTS_ABORT_EXIT, "copy_struct: bad hashmap type %d\n", MAP_HEADER_TYPE(hdr));
}
break;
case BIN_MATCHSTATE_SUBTAG:
erl_exit(ERTS_ABORT_EXIT,
"copy_struct: matchstate term not allowed");
default:
i = thing_arityval(hdr)+1;
hbot -= i;
tp = hbot;
*argp = make_boxed_rel(hbot, dst_base);
while (i--) {
*tp++ = *objp++;
}
}
break;
case TAG_PRIMARY_HEADER:
if (header_is_thing(obj) || hp == const_tuple) {
hp += header_arity(obj) + 1;
} else {
hp++;
}
break;
}
}
#ifdef DEBUG
if (htop != hbot)
erl_exit(ERTS_ABORT_EXIT,
"Internal error in copy_struct() when copying %T:"
" htop=%p != hbot=%p (sz=%beu)\n",
org_obj, htop, hbot, org_sz);
#else
if (htop > hbot) {
erl_exit(ERTS_ABORT_EXIT,
"Internal error in copy_struct(): htop, hbot overrun\n");
}
#endif
*hpp = (Eterm *) (hstart+hsize);
return res;
}
