in erts/emulator/beam/copy.c [1352:1869]
Uint copy_shared_perform_x(Eterm obj, Uint size, erts_shcopy_t *info,
Eterm** hpp, ErlOffHeap* off_heap
#ifdef ERTS_COPY_REGISTER_LOCATION
, char *file, int line
#endif
)
{
Uint e;
unsigned sz;
Eterm* ptr;
Eterm* hp;
Eterm* hscan;
Eterm result;
Eterm* resp;
Eterm *hbot, *hend;
unsigned remaining;
Eterm *lit_purge_ptr = info->lit_purge_ptr;
Uint lit_purge_sz = info->lit_purge_sz;
int copy_literals = info->copy_literals;
#ifdef DEBUG
Eterm mypid = erts_get_current_pid();
Eterm saved_obj = obj;
#endif
DECLARE_EQUEUE_FROM_INFO(s, info);
DECLARE_BITSTORE_FROM_INFO(b, info);
DECLARE_SHTABLE_FROM_INFO(t, info);
/* step #0:
-------------------------------------------------------
get rid of the easy cases first:
- copying constants
- if not a proper process, do flat copy
*/
if (IS_CONST(obj))
return obj;
VERBOSE(DEBUG_SHCOPY, ("[pid=%T] copy_shared_perform %p\n", mypid, obj));
/* step #2: was performed before this function was called
-------------------------------------------------------
allocate new space
*/
hscan = hp = *hpp;
hbot = hend = hp + size;
/* step #3:
-------------------------------------------------------
traverse the term a second time and when traversing:
a. if the object is marked as shared
a1. if the entry contains a forwarding ptr, use that
a2. otherwise, copy it to the new space and store the
forwarding ptr to the entry
b. otherwise, reverse-transform as you do in size_shared
and copy to the new space
*/
resp = &result;
remaining = 0;
for (;;) {
switch (primary_tag(obj)) {
case TAG_PRIMARY_LIST: {
Eterm head, tail;
ptr = list_val(obj);
/* off heap list pointers are copied verbatim */
if (erts_is_literal(obj,ptr)) {
if (!(copy_literals || in_literal_purge_area(ptr))) {
*resp = obj;
} else {
Uint bsz = 0;
*resp = copy_struct_x(obj, hbot - hp, &hp, off_heap, &bsz, NULL
#ifdef ERTS_COPY_REGISTER_LOCATION
, file, line
#endif
); /* copy literal */
hbot -= bsz;
}
goto cleanup_next;
}
head = CAR(ptr);
tail = CDR(ptr);
/* if it is shared */
if (tail == THE_NON_VALUE) {
e = head >> _TAG_PRIMARY_SIZE;
/* if it has been processed, just use the forwarding pointer */
if (primary_tag(head) == LIST_SHARED_PROCESSED) {
*resp = make_list(SHTABLE_FWD(t, e));
goto cleanup_next;
}
/* else, let's process it now,
copy it and keep the forwarding pointer */
else {
CAR(ptr) = (head - primary_tag(head)) + LIST_SHARED_PROCESSED;
head = SHTABLE_X(t, e);
tail = SHTABLE_Y(t, e);
ptr = &(SHTABLE_X(t, e));
VERBOSE(DEBUG_SHCOPY, ("[pid=%T] tabled L %p is %p\n", mypid, ptr, SHTABLE_REV(t, e)));
SHTABLE_FWD_UPD(t, e, hp);
}
}
/* if not already clean, clean it up and copy it */
if (primary_tag(tail) == TAG_PRIMARY_HEADER) {
if (primary_tag(head) == TAG_PRIMARY_HEADER) {
Eterm saved;
BITSTORE_FETCH(b, saved);
VERBOSE(DEBUG_SHCOPY, ("[pid=%T] unmangling L/B %p\n", mypid, ptr));
CAR(ptr) = head = (head - TAG_PRIMARY_HEADER) + saved;
CDR(ptr) = tail = (tail - TAG_PRIMARY_HEADER) + TAG_PRIMARY_BOXED;
} else {
VERBOSE(DEBUG_SHCOPY, ("[pid=%T] unmangling L/L %p\n", mypid, ptr));
CDR(ptr) = tail = (tail - TAG_PRIMARY_HEADER) + TAG_PRIMARY_LIST;
}
} else if (primary_tag(head) == TAG_PRIMARY_HEADER) {
VERBOSE(DEBUG_SHCOPY, ("[pid=%T] unmangling L/I %p\n", mypid, ptr));
CAR(ptr) = head = (head - TAG_PRIMARY_HEADER) | primary_tag(tail);
CDR(ptr) = tail = (tail - primary_tag(tail)) | TAG_PRIMARY_IMMED1;
} else {
ASSERT(0 && "cannot come here");
goto cleanup_next;
}
/* and its children too */
if (IS_CONST(head)) {
CAR(hp) = head;
} else {
EQUEUE_PUT_UNCHECKED(s, head);
CAR(hp) = HEAP_ELEM_TO_BE_FILLED;
}
*resp = make_list(hp);
resp = &(CDR(hp));
hp += 2;
obj = tail;
break;
}
case TAG_PRIMARY_BOXED: {
Eterm hdr;
ptr = boxed_val(obj);
/* off heap pointers to boxes are copied verbatim */
if (erts_is_literal(obj,ptr)) {
if (!(copy_literals || in_literal_purge_area(ptr))) {
*resp = obj;
} else {
Uint bsz = 0;
*resp = copy_struct_x(obj, hbot - hp, &hp, off_heap, &bsz, NULL
#ifdef ERTS_COPY_REGISTER_LOCATION
, file, line
#endif
); /* copy literal */
hbot -= bsz;
}
goto cleanup_next;
}
hdr = *ptr;
/* clean it up, unless it's already clean or shared and processed */
switch (primary_tag(hdr)) {
case TAG_PRIMARY_HEADER:
ASSERT(0 && "cannot come here");
/* if it is shared and has been processed,
just use the forwarding pointer */
case BOXED_SHARED_PROCESSED:
e = hdr >> _TAG_PRIMARY_SIZE;
*resp = make_boxed(SHTABLE_FWD(t, e));
goto cleanup_next;
/* if it is shared but has not been processed yet, let's process
it now: copy it and keep the forwarding pointer */
case BOXED_SHARED_UNPROCESSED:
e = hdr >> _TAG_PRIMARY_SIZE;
*ptr = (hdr - primary_tag(hdr)) + BOXED_SHARED_PROCESSED;
hdr = SHTABLE_X(t, e);
ASSERT(primary_tag(hdr) == BOXED_VISITED);
VERBOSE(DEBUG_SHCOPY, ("[pid=%T] tabled B %p is %p\n", mypid, ptr, SHTABLE_REV(t, e)));
VERBOSE(DEBUG_SHCOPY, ("[pid=%T] unmangling B %p\n", mypid, ptr));
SHTABLE_X(t, e) = hdr = (hdr - BOXED_VISITED) + TAG_PRIMARY_HEADER;
SHTABLE_FWD_UPD(t, e, hp);
break;
case BOXED_VISITED:
VERBOSE(DEBUG_SHCOPY, ("[pid=%T] unmangling B %p\n", mypid, ptr));
*ptr = hdr = (hdr - BOXED_VISITED) + TAG_PRIMARY_HEADER;
break;
}
/* and its children too */
switch (hdr & _TAG_HEADER_MASK) {
case ARITYVAL_SUBTAG: {
int arity = header_arity(hdr);
*resp = make_boxed(hp);
*hp++ = hdr;
while (arity-- > 0) {
obj = *++ptr;
if (IS_CONST(obj)) {
*hp++ = obj;
} else {
EQUEUE_PUT_UNCHECKED(s, obj);
*hp++ = HEAP_ELEM_TO_BE_FILLED;
}
}
goto cleanup_next;
}
case FUN_SUBTAG: {
ErlFunThing* funp = (ErlFunThing *) ptr;
unsigned eterms = 1 /* creator */ + funp->num_free;
sz = thing_arityval(hdr);
funp = (ErlFunThing *) hp;
*resp = make_fun(hp);
*hp++ = hdr;
ptr++;
while (sz-- > 0) {
*hp++ = *ptr++;
}
while (eterms-- > 0) {
obj = *ptr++;
if (IS_CONST(obj)) {
*hp++ = obj;
} else {
EQUEUE_PUT_UNCHECKED(s, obj);
*hp++ = HEAP_ELEM_TO_BE_FILLED;
}
}
funp->next = off_heap->first;
off_heap->first = (struct erl_off_heap_header*) funp;
erts_refc_inc(&funp->fe->refc, 2);
goto cleanup_next;
}
case MAP_SUBTAG:
*resp = make_flatmap(hp);
*hp++ = hdr;
switch (MAP_HEADER_TYPE(hdr)) {
case MAP_HEADER_TAG_FLATMAP_HEAD : {
flatmap_t *mp = (flatmap_t *) ptr;
Uint n = flatmap_get_size(mp) + 1;
*hp++ = *++ptr; /* keys */
while (n--) {
obj = *++ptr;
if (IS_CONST(obj)) {
*hp++ = obj;
} else {
EQUEUE_PUT_UNCHECKED(s, obj);
*hp++ = HEAP_ELEM_TO_BE_FILLED;
}
}
goto cleanup_next;
}
case MAP_HEADER_TAG_HAMT_HEAD_BITMAP :
case MAP_HEADER_TAG_HAMT_HEAD_ARRAY :
*hp++ = *++ptr; /* total map size */
case MAP_HEADER_TAG_HAMT_NODE_BITMAP : {
Uint n = hashmap_bitcount(MAP_HEADER_VAL(hdr));
while (n--) {
obj = *++ptr;
if (IS_CONST(obj)) {
*hp++ = obj;
} else {
EQUEUE_PUT_UNCHECKED(s, obj);
*hp++ = HEAP_ELEM_TO_BE_FILLED;
}
}
goto cleanup_next;
}
default:
erts_exit(ERTS_ABORT_EXIT, "copy_shared_perform: bad hashmap type %d\n", MAP_HEADER_TYPE(hdr));
}
case REFC_BINARY_SUBTAG: {
ProcBin* pb = (ProcBin *) ptr;
sz = thing_arityval(hdr);
if (pb->flags) {
erts_emasculate_writable_binary(pb);
}
pb = (ProcBin *) hp;
*resp = make_binary(hp);
*hp++ = hdr;
ptr++;
while (sz-- > 0) {
*hp++ = *ptr++;
}
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));
goto cleanup_next;
}
case SUB_BINARY_SUBTAG: {
ErlSubBin* sb = (ErlSubBin *) ptr;
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;
*resp = make_binary(hp);
if (extra_bytes != 0) {
ErlSubBin* res = (ErlSubBin *) hp;
hp += ERL_SUB_BIN_SIZE;
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 = make_binary(hp);
}
ASSERT(is_boxed(real_bin));
ptr = _unchecked_binary_val(real_bin);
hdr = *ptr;
switch (primary_tag(hdr)) {
case TAG_PRIMARY_HEADER:
/* real_bin is untouched, ie only referred by sub-bins */
break;
case BOXED_VISITED:
/* real_bin referred directly once */
hdr = (hdr - BOXED_VISITED) + TAG_PRIMARY_HEADER;
break;
case BOXED_SHARED_PROCESSED:
case BOXED_SHARED_UNPROCESSED:
/* real_bin referred directly more than once */
e = hdr >> _TAG_PRIMARY_SIZE;
hdr = SHTABLE_X(t, e);
hdr = (hdr & ~BOXED_VISITED_MASK) + TAG_PRIMARY_HEADER;
break;
}
if (thing_subtag(hdr) == HEAP_BINARY_SUBTAG) {
ErlHeapBin* from = (ErlHeapBin *) ptr;
ErlHeapBin* to = (ErlHeapBin *) hp;
hp += heap_bin_size(real_size);
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 *) ptr;
ProcBin* to = (ProcBin *) hp;
ASSERT(thing_subtag(hdr) == REFC_BINARY_SUBTAG);
if (from->flags) {
erts_emasculate_writable_binary(from);
}
hp += PROC_BIN_SIZE;
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));
}
goto cleanup_next;
}
case EXTERNAL_PID_SUBTAG:
case EXTERNAL_PORT_SUBTAG:
case EXTERNAL_REF_SUBTAG:
{
ExternalThing *etp = (ExternalThing *) ptr;
#if defined(ERTS_COPY_REGISTER_LOCATION) && defined(ERL_NODE_BOOKKEEP)
erts_ref_node_entry__(etp->node, 2, make_boxed(hp), file, line);
#else
erts_ref_node_entry(etp->node, 2, make_boxed(hp));
#endif
}
off_heap_node_container_common:
{
struct erl_off_heap_header *ohhp;
ohhp = (struct erl_off_heap_header *) hp;
sz = thing_arityval(hdr);
*resp = make_boxed(hp);
*hp++ = hdr;
ptr++;
while (sz-- > 0) {
*hp++ = *ptr++;
}
ohhp->next = off_heap->first;
off_heap->first = ohhp;
goto cleanup_next;
}
case REF_SUBTAG:
if (is_magic_ref_thing(ptr)) {
ErtsMRefThing *mreft = (ErtsMRefThing *) ptr;
erts_refc_inc(&mreft->mb->intern.refc, 2);
goto off_heap_node_container_common;
}
/* Fall through... */
default:
sz = thing_arityval(hdr);
*resp = make_boxed(hp);
*hp++ = hdr;
ptr++;
while (sz-- > 0) {
*hp++ = *ptr++;
}
goto cleanup_next;
}
break;
}
case TAG_PRIMARY_IMMED1:
*resp = obj;
cleanup_next:
if (EQUEUE_ISEMPTY(s)) {
goto all_clean;
}
obj = EQUEUE_GET(s);
for (;;) {
ASSERT(hscan < hp);
if (remaining == 0) {
if (*hscan == HEAP_ELEM_TO_BE_FILLED) {
resp = hscan;
hscan += 2;
break; /* scanning loop */
} else if (primary_tag(*hscan) == TAG_PRIMARY_HEADER) {
switch (*hscan & _TAG_HEADER_MASK) {
case ARITYVAL_SUBTAG:
remaining = header_arity(*hscan);
hscan++;
break;
case FUN_SUBTAG: {
ErlFunThing* funp = (ErlFunThing *) hscan;
hscan += 1 + thing_arityval(*hscan);
remaining = 1 + funp->num_free;
break;
}
case MAP_SUBTAG:
switch (MAP_HEADER_TYPE(*hscan)) {
case MAP_HEADER_TAG_FLATMAP_HEAD : {
flatmap_t *mp = (flatmap_t *) hscan;
remaining = flatmap_get_size(mp) + 1;
hscan += 2;
break;
}
case MAP_HEADER_TAG_HAMT_HEAD_BITMAP :
case MAP_HEADER_TAG_HAMT_HEAD_ARRAY :
case MAP_HEADER_TAG_HAMT_NODE_BITMAP :
remaining = hashmap_bitcount(MAP_HEADER_VAL(*hscan));
hscan += MAP_HEADER_ARITY(*hscan) + 1;
break;
default:
erts_exit(ERTS_ABORT_EXIT,
"copy_shared_perform: bad hashmap type %d\n",
MAP_HEADER_TYPE(*hscan));
}
break;
case SUB_BINARY_SUBTAG:
ASSERT(((ErlSubBin *) hscan)->bitoffs +
((ErlSubBin *) hscan)->bitsize > 0);
hscan += ERL_SUB_BIN_SIZE;
break;
default:
hscan += 1 + thing_arityval(*hscan);
break;
}
} else {
hscan++;
}
} else if (*hscan == HEAP_ELEM_TO_BE_FILLED) {
resp = hscan++;
remaining--;
break; /* scanning loop */
} else {
hscan++;
remaining--;
}
}
ASSERT(resp < hp);
break;
default:
erts_exit(ERTS_ABORT_EXIT, "size_shared: bad tag for %#x\n", obj);
}
}
/* step #4:
-------------------------------------------------------
traverse the table and reverse-transform all stored entries
*/
all_clean:
for (e = 0; ; e += SHTABLE_INCR) {
ptr = SHTABLE_REV(t, e);
if (ptr == NULL)
break;
VERBOSE(DEBUG_SHCOPY, ("[copy] restoring shared: %x\n", ptr));
/* entry was a list */
if (SHTABLE_Y(t, e) != THE_NON_VALUE) {
VERBOSE(DEBUG_SHCOPY, ("[pid=%T] untabling L %p\n", mypid, ptr));
CAR(ptr) = SHTABLE_X(t, e);
CDR(ptr) = SHTABLE_Y(t, e);
}
/* entry was boxed */
else {
VERBOSE(DEBUG_SHCOPY, ("[pid=%T] untabling B %p\n", mypid, ptr));
*ptr = SHTABLE_X(t, e);
ASSERT(primary_tag(*ptr) == TAG_PRIMARY_HEADER);
}
}
#ifdef DEBUG
if (eq(saved_obj, result) == 0) {
erts_fprintf(stderr, "original = %T\n", saved_obj);
erts_fprintf(stderr, "copy = %T\n", result);
erts_exit(ERTS_ABORT_EXIT, "copy (shared) not equal to source\n");
}
#endif
VERBOSE(DEBUG_SHCOPY, ("[pid=%T] original was %T\n", mypid, saved_obj));
VERBOSE(DEBUG_SHCOPY, ("[pid=%T] copy is %T\n", mypid, result));
VERBOSE(DEBUG_SHCOPY, ("[pid=%T] result is at %p\n", mypid, result));
ASSERT(hbot == hp);
ASSERT(size == ((hp - *hpp) + (hend - hbot)));
*hpp = hend;
return result;
}