in erts/emulator/beam/copy.c [607:963]
Eterm copy_struct_x(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap,
Uint *bsz, erts_literal_area_t *litopt
#ifdef ERTS_COPY_REGISTER_LOCATION
, char *file, int line
#endif
)
{
char* hstart;
Uint hsize;
Eterm* htop;
Eterm* hbot;
Eterm* hp;
Eterm* ERTS_RESTRICT objp;
Eterm* tp;
Eterm res;
Eterm elem;
Eterm* tailp;
Eterm* argp;
Eterm* const_tuple;
Eterm hdr;
Eterm *hend;
int i;
Eterm *lit_purge_ptr = litopt ? litopt->lit_purge_ptr : NULL;
Uint lit_purge_sz = litopt ? litopt->lit_purge_sz : 0;
#ifdef DEBUG
Eterm org_obj = obj;
Uint org_sz = sz;
Eterm mypid = erts_get_current_pid();
#endif
if (IS_CONST(obj))
return obj;
VERBOSE(DEBUG_SHCOPY, ("[pid=%T] copy_struct %p\n", mypid, obj));
DTRACE1(copy_struct, (int32_t)sz);
hp = htop = *hpp;
hbot = hend = 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(obj);
goto L_copy_list;
case TAG_PRIMARY_BOXED: argp = &res; goto L_copy_boxed;
default:
erts_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 (ErtsInArea(objp,hstart,hsize)) {
hp++;
break;
}
argp = hp++;
/* Fall through */
L_copy_list:
tailp = argp;
if (litopt && erts_is_literal(obj,objp) && !in_literal_purge_area(objp)) {
*tailp = obj;
goto L_copy;
}
for (;;) {
tp = tailp;
elem = CAR(objp);
if (IS_CONST(elem)) {
hbot -= 2;
CAR(hbot) = elem;
tailp = &CDR(hbot);
} else {
CAR(htop) = elem;
tailp = &CDR(htop);
htop += 2;
}
*tp = make_list(tailp - 1);
obj = CDR(objp);
if (!is_list(obj)) {
break;
}
objp = list_val(obj);
if (litopt && erts_is_literal(obj,objp) && !in_literal_purge_area(objp)) {
*tailp = obj;
goto L_copy;
}
}
switch (primary_tag(obj)) {
case TAG_PRIMARY_IMMED1: *tailp = obj; goto L_copy;
case TAG_PRIMARY_BOXED: argp = tailp; goto L_copy_boxed;
default:
erts_exit(ERTS_ABORT_EXIT,
"%s, line %d: Internal error in copy_struct: 0x%08x\n",
__FILE__, __LINE__,obj);
}
case TAG_PRIMARY_BOXED:
if (ErtsInArea(boxed_val(obj),hstart,hsize)) {
hp++;
break;
}
argp = hp++;
L_copy_boxed:
objp = boxed_val(obj);
if (litopt && erts_is_literal(obj,objp) && !in_literal_purge_area(objp)) {
*argp = obj;
break;
}
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->intern.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(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->intern.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(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++;
}
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(tp);
}
break;
case EXTERNAL_PID_SUBTAG:
case EXTERNAL_PORT_SUBTAG:
case EXTERNAL_REF_SUBTAG:
{
ExternalThing *etp = (ExternalThing *) objp;
#if defined(ERTS_COPY_REGISTER_LOCATION) && defined(ERL_NODE_BOOKKEEP)
erts_ref_node_entry__(etp->node, 2, make_boxed(htop), file, line);
#else
erts_ref_node_entry(etp->node, 2, make_boxed(htop));
#endif
}
L_off_heap_node_container_common:
{
struct erl_off_heap_header *ohhp;
ohhp = (struct erl_off_heap_header *) htop;
i = thing_arityval(hdr) + 1;
*argp = make_boxed(htop);
tp = htop;
while (i--) {
*htop++ = *objp++;
}
ohhp->next = off_heap->first;
off_heap->first = ohhp;
}
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(htop);
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(tp);
break;
default:
erts_exit(ERTS_ABORT_EXIT, "copy_struct: bad hashmap type %d\n", MAP_HEADER_TYPE(hdr));
}
break;
case BIN_MATCHSTATE_SUBTAG:
erts_exit(ERTS_ABORT_EXIT,
"copy_struct: matchstate term not allowed");
case REF_SUBTAG:
if (is_magic_ref_thing(objp)) {
ErtsMRefThing *mreft = (ErtsMRefThing *) objp;
erts_refc_inc(&mreft->mb->intern.refc, 2);
goto L_off_heap_node_container_common;
}
/* Fall through... */
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;
}
}
if (bsz) {
*hpp = htop;
*bsz = hend - hbot;
} else {
#ifdef DEBUG
if (!eq(org_obj, res)) {
erts_exit(ERTS_ABORT_EXIT,
"Internal error in copy_struct() when copying %T:"
" not equal to copy %T\n",
org_obj, res);
}
if (htop != hbot)
erts_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) {
erts_exit(ERTS_ABORT_EXIT,
"Internal error in copy_struct(): htop, hbot overrun\n");
}
#endif
*hpp = (Eterm *) (hstart+hsize);
}
VERBOSE(DEBUG_SHCOPY, ("[pid=%T] result is at %p\n", mypid, res));
return res;
}