static void print_heap(Eterm *pos, Eterm *end)
{
printf("From: 0x%0*lx to 0x%0*lx\n\r",
2*(int)sizeof(long), (unsigned long)pos,
2*(int)sizeof(long), (unsigned long)end);
printf(" | H E A P |\r\n");
printf(" | %*s | %*s |\r\n",
2+2*(int)sizeof(long), "Address",
2+2*(int)sizeof(long), "Contents");
printf(" |%s|%s|\r\n", dashes, dashes);
while (pos < end) {
Eterm val = pos[0];
printf(" | 0x%0*lx | 0x%0*lx | ",
2*(int)sizeof(long), (unsigned long)pos,
2*(int)sizeof(long), (unsigned long)val);
++pos;
if (is_arity_value(val))
printf("Arity(%lu)", arityval(val));
else if (is_thing(val)) {
unsigned int ari = thing_arityval(val);
printf("Thing Arity(%u) Tag(%lu)", ari, thing_subtag(val));
while (ari) {
printf("\r\n | 0x%0*lx | 0x%0*lx | THING",
2*(int)sizeof(long), (unsigned long)pos,
2*(int)sizeof(long), (unsigned long)*pos);
++pos;
--ari;
}
} else
erts_printf("%.30T", val);
printf("\r\n");
}
printf(" |%s|%s|\r\n", dashes, dashes);
}
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 (ErtsInArea(val, mod_start, mod_size)) {
return 1;
}
break;
case TAG_PRIMARY_HEADER:
if (!header_is_transparent(val)) {
Eterm* new_p;
if (header_is_bin_matchstate(val)) {
ErlBinMatchState *ms = (ErlBinMatchState*) p;
ErlBinMatchBuffer *mb = &(ms->mb);
if (ErtsInArea(mb->orig, mod_start, mod_size)) {
return 1;
}
}
new_p = p + thing_arityval(val);
ASSERT(start <= new_p && new_p < end);
p = new_p;
}
}
}
return 0;
}
static Uint
hfrag_literal_size(Eterm* start, Eterm* end, char* lit_start, Uint lit_size)
{
Eterm* p;
Eterm val;
Uint sz = 0;
for (p = start; p < end; p++) {
val = *p;
switch (primary_tag(val)) {
case TAG_PRIMARY_BOXED:
case TAG_PRIMARY_LIST:
if (ErtsInArea(val, lit_start, lit_size)) {
sz += size_object(val);
}
break;
case TAG_PRIMARY_HEADER:
if (!header_is_transparent(val)) {
Eterm* new_p;
if (header_is_bin_matchstate(val)) {
ErlBinMatchState *ms = (ErlBinMatchState*) p;
ErlBinMatchBuffer *mb = &(ms->mb);
if (ErtsInArea(mb->orig, lit_start, lit_size)) {
sz += size_object(mb->orig);
}
}
new_p = p + thing_arityval(val);
ASSERT(start <= new_p && new_p < end);
p = new_p;
}
}
}
return sz;
}
void erts_check_memory(Process *p, Eterm *start, Eterm *end)
{
Eterm *pos = start;
while (pos < end) {
Eterm hval = *pos++;
#ifdef DEBUG
if (hval == DEBUG_BAD_WORD) {
print_untagged_memory(start, end);
erts_exit(ERTS_ERROR_EXIT, "Uninitialized HAlloc'ed memory found @ 0x%0*lx!\n",
PTR_SIZE,(unsigned long)(pos - 1));
}
#endif
if (is_thing(hval)) {
pos += thing_arityval(hval);
continue;
}
if (verify_eterm(p,hval))
continue;
erts_exit(ERTS_ERROR_EXIT, "Wild pointer found @ 0x%0*lx!\n",
PTR_SIZE,(unsigned long)(pos - 1));
}
}
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;
}
/*
* print_tagged_memory will print contents of given memory area and
* display it as if it was tagged Erlang terms (which it hopefully
* is). This function knows about forwarding pointers to be able to
* print a heap during garbage collection. erts_printf("%T",val)
* do not know about forwarding pointers though, so it will still
* crash if they are encoutered...
*/
void print_tagged_memory(Eterm *pos, Eterm *end)
{
erts_printf("+-%s-+-%s-+\n",dashes,dashes);
erts_printf("| 0x%0*lx - 0x%0*lx |\n",
PTR_SIZE,(unsigned long)pos,
PTR_SIZE,(unsigned long)(end - 1));
erts_printf("| %-*s | %-*s |\n",PTR_SIZE,"Address",PTR_SIZE,"Contents");
erts_printf("|-%s-|-%s-|\n",dashes,dashes);
while( pos < end ) {
Eterm val = pos[0];
erts_printf("| 0x%0*lx | 0x%0*lx | ",
PTR_SIZE,(unsigned long)pos, PTR_SIZE,(unsigned long)val);
++pos;
if( is_arity_value(val) ) {
erts_printf("Arity(%lu)", arityval(val));
} else if( is_thing(val) ) {
unsigned int ari = thing_arityval(val);
erts_printf("Thing Arity(%u) Tag(%lu)", ari, thing_subtag(val));
while( ari ) {
erts_printf("\n| 0x%0*lx | 0x%0*lx | THING",
PTR_SIZE, (unsigned long)pos,
PTR_SIZE, (unsigned long)*pos);
++pos;
--ari;
}
} else {
switch (primary_tag(val)) {
case TAG_PRIMARY_BOXED:
if (!is_header(*boxed_val(val))) {
erts_printf("Moved -> 0x%0*lx\n",PTR_SIZE,
(unsigned long)*boxed_val(val));
continue;
}
break;
case TAG_PRIMARY_LIST:
if (is_non_value(*list_val(val))) {
erts_printf("Moved -> 0x%0*lx\n",PTR_SIZE,
(unsigned long)*(list_val(val) + 1));
continue;
}
break;
}
erts_printf("%.30T", val);
}
erts_printf("\n");
}
erts_printf("+-%s-+-%s-+\n",dashes,dashes);
}
static void check_memory(Eterm *start, Eterm *end)
{
Eterm *pos = start;
while (pos < end) {
Eterm hval = *pos++;
if (hval == ERTS_HOLE_MARKER) {
erts_fprintf(stderr,"%s, line %d: ERTS_HOLE_MARKER found at 0x%0*lx\n",
__FILE__, __LINE__,PTR_SIZE,(unsigned long)(pos-1));
print_untagged_memory(start,end); /* DEBUGSTUFF */
abort();
} else if (is_thing(hval)) {
pos += (thing_arityval(hval));
}
}
}
/* Move all terms in heap fragments into heap. The terms must be guaranteed to
* be contained within the fragments. The source terms are destructed with
* move markers.
* Typically used to copy a multi-fragmented message (from NIF).
*/
void move_multi_frags(Eterm** hpp, ErlOffHeap* off_heap, ErlHeapFragment* first,
Eterm* refs, unsigned nrefs)
{
ErlHeapFragment* bp;
Eterm* hp_start = *hpp;
Eterm* hp_end;
Eterm* hp;
unsigned i;
for (bp=first; bp!=NULL; bp=bp->next) {
move_one_frag(hpp, bp->mem, bp->used_size, off_heap);
off_heap->overhead += bp->off_heap.overhead;
}
hp_end = *hpp;
for (hp=hp_start; hp<hp_end; ++hp) {
Eterm* ptr;
Eterm val;
Eterm gval = *hp;
switch (primary_tag(gval)) {
case TAG_PRIMARY_BOXED:
ptr = boxed_val(gval);
val = *ptr;
if (IS_MOVED_BOXED(val)) {
ASSERT(is_boxed(val));
*hp = val;
}
break;
case TAG_PRIMARY_LIST:
ptr = list_val(gval);
val = *ptr;
if (IS_MOVED_CONS(val)) {
*hp = ptr[1];
}
break;
case TAG_PRIMARY_HEADER:
if (header_is_thing(gval)) {
hp += thing_arityval(gval);
}
break;
}
}
for (i=0; i<nrefs; ++i) {
refs[i] = follow_moved(refs[i]);
}
}
static void
hfrag_literal_copy(Eterm **hpp, ErlOffHeap *ohp,
Eterm *start, Eterm *end,
char *lit_start, Uint lit_size) {
Eterm* p;
Eterm val;
Uint sz;
for (p = start; p < end; p++) {
val = *p;
switch (primary_tag(val)) {
case TAG_PRIMARY_BOXED:
case TAG_PRIMARY_LIST:
if (ErtsInArea(val, lit_start, lit_size)) {
sz = size_object(val);
val = copy_struct(val, sz, hpp, ohp);
*p = val;
}
break;
case TAG_PRIMARY_HEADER:
if (!header_is_transparent(val)) {
Eterm* new_p;
/* matchstate in message, not possible. */
if (header_is_bin_matchstate(val)) {
ErlBinMatchState *ms = (ErlBinMatchState*) p;
ErlBinMatchBuffer *mb = &(ms->mb);
if (ErtsInArea(mb->orig, lit_start, lit_size)) {
sz = size_object(mb->orig);
mb->orig = copy_struct(mb->orig, sz, hpp, ohp);
}
}
new_p = p + thing_arityval(val);
ASSERT(start <= new_p && new_p < end);
p = new_p;
}
}
}
}
BIF_RETTYPE hipe_bifs_show_term_1(BIF_ALIST_1)
{
Eterm obj = BIF_ARG_1;
printf("0x%0*lx\r\n", 2*(int)sizeof(long), obj);
do {
Eterm *objp;
int i, ary;
if (is_list(obj)) {
objp = list_val(obj);
ary = 2;
} else if (is_boxed(obj)) {
Eterm header;
objp = boxed_val(obj);
header = objp[0];
if (is_thing(header))
ary = thing_arityval(header);
else if (is_arity_value(header))
ary = arityval(header);
else {
printf("bad header %#lx\r\n", header);
break;
}
ary += 1;
} else
break;
for (i = 0; i < ary; ++i)
printf("0x%0*lx: 0x%0*lx\r\n",
2*(int)sizeof(long), (unsigned long)&objp[i],
2*(int)sizeof(long), objp[i]);
} while (0);
erts_printf("%T", obj);
printf("\r\n");
BIF_RET(am_true);
}
/*
* Moves content of message buffer attached to a message into a heap.
* The message buffer is deallocated.
*/
void
erts_move_msg_mbuf_to_heap(Eterm** hpp, ErlOffHeap* off_heap, ErlMessage *msg)
{
/* Unions for typecasts avoids warnings about type-punned pointers and aliasing */
union {
Uint** upp;
ProcBin **pbpp;
ErlFunThing **efpp;
ExternalThing **etpp;
} oh_list_pp, oh_el_next_pp;
union {
Uint *up;
ProcBin *pbp;
ErlFunThing *efp;
ExternalThing *etp;
} oh_el_p;
Eterm term, token, *fhp, *hp;
Sint offs;
Uint sz;
ErlHeapFragment *bp;
#ifdef HARD_DEBUG
ProcBin *dbg_mso_start = off_heap->mso;
ErlFunThing *dbg_fun_start = off_heap->funs;
ExternalThing *dbg_external_start = off_heap->externals;
Eterm dbg_term, dbg_token;
ErlHeapFragment *dbg_bp;
Uint *dbg_hp, *dbg_thp_start;
Uint dbg_term_sz, dbg_token_sz;
#endif
bp = msg->data.heap_frag;
term = ERL_MESSAGE_TERM(msg);
token = ERL_MESSAGE_TOKEN(msg);
if (!bp) {
ASSERT(is_immed(term) && is_immed(token));
return;
}
#ifdef HARD_DEBUG
dbg_term_sz = size_object(term);
dbg_token_sz = size_object(token);
ASSERT(bp->size == dbg_term_sz + dbg_token_sz);
dbg_bp = new_message_buffer(bp->size);
dbg_hp = dbg_bp->mem;
dbg_term = copy_struct(term, dbg_term_sz, &dbg_hp, &dbg_bp->off_heap);
dbg_token = copy_struct(token, dbg_token_sz, &dbg_hp, &dbg_bp->off_heap);
dbg_thp_start = *hpp;
#endif
ASSERT(bp);
msg->data.attached = NULL;
off_heap->overhead += bp->off_heap.overhead;
sz = bp->size;
#ifdef DEBUG
if (is_not_immed(term)) {
ASSERT(bp->mem <= ptr_val(term));
ASSERT(bp->mem + bp->size > ptr_val(term));
}
if (is_not_immed(token)) {
ASSERT(bp->mem <= ptr_val(token));
ASSERT(bp->mem + bp->size > ptr_val(token));
}
#endif
fhp = bp->mem;
hp = *hpp;
offs = hp - fhp;
oh_list_pp.upp = NULL;
oh_el_next_pp.upp = NULL; /* Shut up compiler warning */
oh_el_p.up = NULL; /* Shut up compiler warning */
while (sz--) {
Uint cpy_sz;
Eterm val = *fhp++;
switch (primary_tag(val)) {
case TAG_PRIMARY_IMMED1:
*hp++ = val;
break;
case TAG_PRIMARY_LIST:
case TAG_PRIMARY_BOXED:
ASSERT(bp->mem <= ptr_val(val));
ASSERT(bp->mem + bp->size > ptr_val(val));
*hp++ = offset_ptr(val, offs);
break;
case TAG_PRIMARY_HEADER:
*hp++ = val;
switch (val & _HEADER_SUBTAG_MASK) {
case ARITYVAL_SUBTAG:
break;
case REFC_BINARY_SUBTAG:
oh_list_pp.pbpp = &off_heap->mso;
oh_el_p.up = (hp-1);
oh_el_next_pp.pbpp = &(oh_el_p.pbp)->next;
cpy_sz = thing_arityval(val);
goto cpy_words;
case FUN_SUBTAG:
#ifndef HYBRID
oh_list_pp.efpp = &off_heap->funs;
oh_el_p.up = (hp-1);
oh_el_next_pp.efpp = &(oh_el_p.efp)->next;
#endif
cpy_sz = thing_arityval(val);
goto cpy_words;
case EXTERNAL_PID_SUBTAG:
case EXTERNAL_PORT_SUBTAG:
case EXTERNAL_REF_SUBTAG:
oh_list_pp.etpp = &off_heap->externals;
oh_el_p.up = (hp-1);
oh_el_next_pp.etpp = &(oh_el_p.etp)->next;
cpy_sz = thing_arityval(val);
goto cpy_words;
default:
cpy_sz = header_arity(val);
cpy_words:
sz -= cpy_sz;
while (cpy_sz >= 8) {
cpy_sz -= 8;
*hp++ = *fhp++;
*hp++ = *fhp++;
*hp++ = *fhp++;
*hp++ = *fhp++;
*hp++ = *fhp++;
*hp++ = *fhp++;
*hp++ = *fhp++;
*hp++ = *fhp++;
}
switch (cpy_sz) {
case 7: *hp++ = *fhp++;
case 6: *hp++ = *fhp++;
case 5: *hp++ = *fhp++;
case 4: *hp++ = *fhp++;
case 3: *hp++ = *fhp++;
case 2: *hp++ = *fhp++;
case 1: *hp++ = *fhp++;
default: break;
}
if (oh_list_pp.upp) {
#ifdef HARD_DEBUG
Uint *dbg_old_oh_list_p = *oh_list_pp.upp;
#endif
/* Add to offheap list */
*oh_el_next_pp.upp = *oh_list_pp.upp;
*oh_list_pp.upp = oh_el_p.up;
ASSERT(*hpp <= oh_el_p.up);
ASSERT(hp > oh_el_p.up);
#ifdef HARD_DEBUG
switch (val & _HEADER_SUBTAG_MASK) {
case REFC_BINARY_SUBTAG:
ASSERT(off_heap->mso == *oh_list_pp.pbpp);
ASSERT(off_heap->mso->next
== (ProcBin *) dbg_old_oh_list_p);
break;
#ifndef HYBRID
case FUN_SUBTAG:
ASSERT(off_heap->funs == *oh_list_pp.efpp);
ASSERT(off_heap->funs->next
== (ErlFunThing *) dbg_old_oh_list_p);
break;
#endif
case EXTERNAL_PID_SUBTAG:
case EXTERNAL_PORT_SUBTAG:
case EXTERNAL_REF_SUBTAG:
ASSERT(off_heap->externals
== *oh_list_pp.etpp);
ASSERT(off_heap->externals->next
== (ExternalThing *) dbg_old_oh_list_p);
break;
default:
ASSERT(0);
}
#endif
oh_list_pp.upp = NULL;
}
break;
}
break;
}
}
ASSERT(bp->size == hp - *hpp);
*hpp = hp;
if (is_not_immed(token)) {
ASSERT(bp->mem <= ptr_val(token));
ASSERT(bp->mem + bp->size > ptr_val(token));
ERL_MESSAGE_TOKEN(msg) = offset_ptr(token, offs);
#ifdef HARD_DEBUG
ASSERT(dbg_thp_start <= ptr_val(ERL_MESSAGE_TOKEN(msg)));
ASSERT(hp > ptr_val(ERL_MESSAGE_TOKEN(msg)));
#endif
}
if (is_not_immed(term)) {
ASSERT(bp->mem <= ptr_val(term));
ASSERT(bp->mem + bp->size > ptr_val(term));
ERL_MESSAGE_TERM(msg) = offset_ptr(term, offs);
#ifdef HARD_DEBUG
ASSERT(dbg_thp_start <= ptr_val(ERL_MESSAGE_TERM(msg)));
ASSERT(hp > ptr_val(ERL_MESSAGE_TERM(msg)));
#endif
}
#ifdef HARD_DEBUG
{
int i, j;
{
ProcBin *mso = off_heap->mso;
i = j = 0;
while (mso != dbg_mso_start) {
mso = mso->next;
i++;
}
mso = bp->off_heap.mso;
while (mso) {
mso = mso->next;
j++;
}
ASSERT(i == j);
}
{
ErlFunThing *fun = off_heap->funs;
i = j = 0;
while (fun != dbg_fun_start) {
fun = fun->next;
i++;
}
fun = bp->off_heap.funs;
while (fun) {
fun = fun->next;
j++;
}
ASSERT(i == j);
}
{
ExternalThing *external = off_heap->externals;
i = j = 0;
while (external != dbg_external_start) {
external = external->next;
i++;
}
external = bp->off_heap.externals;
while (external) {
external = external->next;
j++;
}
ASSERT(i == j);
}
}
#endif
bp->off_heap.mso = NULL;
#ifndef HYBRID
bp->off_heap.funs = NULL;
#endif
bp->off_heap.externals = NULL;
free_message_buffer(bp);
#ifdef HARD_DEBUG
ASSERT(eq(ERL_MESSAGE_TERM(msg), dbg_term));
ASSERT(eq(ERL_MESSAGE_TOKEN(msg), dbg_token));
free_message_buffer(dbg_bp);
#endif
}
Uint size_object(Eterm obj)
#endif
{
Uint sum = 0;
Eterm* ptr;
int arity;
DECLARE_ESTACK(s);
for (;;) {
switch (primary_tag(obj)) {
case TAG_PRIMARY_LIST:
sum += 2;
ptr = list_val_rel(obj,base);
obj = *ptr++;
if (!IS_CONST(obj)) {
ESTACK_PUSH(s, obj);
}
obj = *ptr;
break;
case TAG_PRIMARY_BOXED:
{
Eterm hdr = *boxed_val_rel(obj,base);
ASSERT(is_header(hdr));
switch (hdr & _TAG_HEADER_MASK) {
case ARITYVAL_SUBTAG:
ptr = tuple_val_rel(obj,base);
arity = header_arity(hdr);
sum += arity + 1;
if (arity == 0) { /* Empty tuple -- unusual. */
goto pop_next;
}
while (arity-- > 1) {
obj = *++ptr;
if (!IS_CONST(obj)) {
ESTACK_PUSH(s, obj);
}
}
obj = *++ptr;
break;
case FUN_SUBTAG:
{
Eterm* bptr = fun_val_rel(obj,base);
ErlFunThing* funp = (ErlFunThing *) bptr;
unsigned eterms = 1 /* creator */ + funp->num_free;
unsigned sz = thing_arityval(hdr);
sum += 1 /* header */ + sz + eterms;
bptr += 1 /* header */ + sz;
while (eterms-- > 1) {
obj = *bptr++;
if (!IS_CONST(obj)) {
ESTACK_PUSH(s, obj);
}
}
obj = *bptr;
break;
}
case MAP_SUBTAG:
switch (MAP_HEADER_TYPE(hdr)) {
case MAP_HEADER_TAG_FLATMAP_HEAD :
{
Uint n;
flatmap_t *mp;
mp = (flatmap_t*)flatmap_val_rel(obj,base);
ptr = (Eterm *)mp;
n = flatmap_get_size(mp) + 1;
sum += n + 2;
ptr += 2; /* hdr + size words */
while (n--) {
obj = *ptr++;
if (!IS_CONST(obj)) {
ESTACK_PUSH(s, obj);
}
}
goto pop_next;
}
case MAP_HEADER_TAG_HAMT_HEAD_BITMAP :
case MAP_HEADER_TAG_HAMT_HEAD_ARRAY :
case MAP_HEADER_TAG_HAMT_NODE_BITMAP :
{
Eterm *head;
Uint sz;
head = hashmap_val_rel(obj, base);
sz = hashmap_bitcount(MAP_HEADER_VAL(hdr));
sum += 1 + sz + header_arity(hdr);
head += 1 + header_arity(hdr);
if (sz == 0) {
goto pop_next;
}
while(sz-- > 1) {
obj = head[sz];
if (!IS_CONST(obj)) {
ESTACK_PUSH(s, obj);
}
}
obj = head[0];
}
break;
default:
erl_exit(ERTS_ABORT_EXIT, "size_object: bad hashmap type %d\n", MAP_HEADER_TYPE(hdr));
}
break;
case SUB_BINARY_SUBTAG:
{
Eterm real_bin;
ERTS_DECLARE_DUMMY(Uint offset); /* Not used. */
Uint bitsize;
Uint bitoffs;
Uint extra_bytes;
Eterm hdr;
ERTS_GET_REAL_BIN_REL(obj, real_bin, offset, bitoffs, bitsize, base);
if ((bitsize + bitoffs) > 8) {
sum += ERL_SUB_BIN_SIZE;
extra_bytes = 2;
} else if ((bitsize + bitoffs) > 0) {
sum += ERL_SUB_BIN_SIZE;
extra_bytes = 1;
} else {
extra_bytes = 0;
}
hdr = *binary_val_rel(real_bin,base);
if (thing_subtag(hdr) == REFC_BINARY_SUBTAG) {
sum += PROC_BIN_SIZE;
} else {
sum += heap_bin_size(binary_size_rel(obj,base)+extra_bytes);
}
goto pop_next;
}
break;
case BIN_MATCHSTATE_SUBTAG:
erl_exit(ERTS_ABORT_EXIT,
"size_object: matchstate term not allowed");
default:
sum += thing_arityval(hdr) + 1;
goto pop_next;
}
}
break;
case TAG_PRIMARY_IMMED1:
pop_next:
if (ESTACK_ISEMPTY(s)) {
DESTROY_ESTACK(s);
return sum;
}
obj = ESTACK_POP(s);
break;
default:
erl_exit(ERTS_ABORT_EXIT, "size_object: bad tag for %#x\n", obj);
}
}
}
/*
* Moves content of message buffer attached to a message into a heap.
* The message buffer is deallocated.
*/
void
erts_move_msg_mbuf_to_heap(Eterm** hpp, ErlOffHeap* off_heap, ErlMessage *msg)
{
struct erl_off_heap_header* oh;
Eterm term, token, *fhp, *hp;
Sint offs;
Uint sz;
ErlHeapFragment *bp;
#ifdef USE_VM_PROBES
Eterm utag;
#endif
#ifdef HARD_DEBUG
struct erl_off_heap_header* dbg_oh_start = off_heap->first;
Eterm dbg_term, dbg_token;
ErlHeapFragment *dbg_bp;
Uint *dbg_hp, *dbg_thp_start;
Uint dbg_term_sz, dbg_token_sz;
#ifdef USE_VM_PROBES
Eterm dbg_utag;
Uint dbg_utag_sz;
#endif
#endif
bp = msg->data.heap_frag;
term = ERL_MESSAGE_TERM(msg);
token = ERL_MESSAGE_TOKEN(msg);
#ifdef USE_VM_PROBES
utag = ERL_MESSAGE_DT_UTAG(msg);
#endif
if (!bp) {
#ifdef USE_VM_PROBES
ASSERT(is_immed(term) && is_immed(token) && is_immed(utag));
#else
ASSERT(is_immed(term) && is_immed(token));
#endif
return;
}
#ifdef HARD_DEBUG
dbg_term_sz = size_object(term);
dbg_token_sz = size_object(token);
dbg_bp = new_message_buffer(dbg_term_sz + dbg_token_sz);
#ifdef USE_VM_PROBES
dbg_utag_sz = size_object(utag);
dbg_bp = new_message_buffer(dbg_term_sz + dbg_token_sz + dbg_utag_sz );
#endif
/*ASSERT(dbg_term_sz + dbg_token_sz == erts_msg_used_frag_sz(msg));
Copied size may be smaller due to removed SubBins's or garbage.
Copied size may be larger due to duplicated shared terms.
*/
dbg_hp = dbg_bp->mem;
dbg_term = copy_struct(term, dbg_term_sz, &dbg_hp, &dbg_bp->off_heap);
dbg_token = copy_struct(token, dbg_token_sz, &dbg_hp, &dbg_bp->off_heap);
#ifdef USE_VM_PROBES
dbg_utag = copy_struct(utag, dbg_utag_sz, &dbg_hp, &dbg_bp->off_heap);
#endif
dbg_thp_start = *hpp;
#endif
if (bp->next != NULL) {
move_multi_frags(hpp, off_heap, bp, msg->m,
#ifdef USE_VM_PROBES
3
#else
2
#endif
);
goto copy_done;
}
OH_OVERHEAD(off_heap, bp->off_heap.overhead);
sz = bp->used_size;
ASSERT(is_immed(term) || in_heapfrag(ptr_val(term),bp));
ASSERT(is_immed(token) || in_heapfrag(ptr_val(token),bp));
fhp = bp->mem;
hp = *hpp;
offs = hp - fhp;
oh = NULL;
while (sz--) {
Uint cpy_sz;
Eterm val = *fhp++;
switch (primary_tag(val)) {
case TAG_PRIMARY_IMMED1:
*hp++ = val;
break;
case TAG_PRIMARY_LIST:
case TAG_PRIMARY_BOXED:
ASSERT(in_heapfrag(ptr_val(val), bp));
*hp++ = offset_ptr(val, offs);
break;
case TAG_PRIMARY_HEADER:
*hp++ = val;
switch (val & _HEADER_SUBTAG_MASK) {
case ARITYVAL_SUBTAG:
break;
case REFC_BINARY_SUBTAG:
case FUN_SUBTAG:
case EXTERNAL_PID_SUBTAG:
case EXTERNAL_PORT_SUBTAG:
case EXTERNAL_REF_SUBTAG:
oh = (struct erl_off_heap_header*) (hp-1);
cpy_sz = thing_arityval(val);
goto cpy_words;
default:
cpy_sz = header_arity(val);
cpy_words:
ASSERT(sz >= cpy_sz);
sz -= cpy_sz;
while (cpy_sz >= 8) {
cpy_sz -= 8;
*hp++ = *fhp++;
*hp++ = *fhp++;
*hp++ = *fhp++;
*hp++ = *fhp++;
*hp++ = *fhp++;
*hp++ = *fhp++;
*hp++ = *fhp++;
*hp++ = *fhp++;
}
switch (cpy_sz) {
case 7: *hp++ = *fhp++;
case 6: *hp++ = *fhp++;
case 5: *hp++ = *fhp++;
case 4: *hp++ = *fhp++;
case 3: *hp++ = *fhp++;
case 2: *hp++ = *fhp++;
case 1: *hp++ = *fhp++;
default: break;
}
if (oh) {
/* Add to offheap list */
oh->next = off_heap->first;
off_heap->first = oh;
ASSERT(*hpp <= (Eterm*)oh);
ASSERT(hp > (Eterm*)oh);
oh = NULL;
}
break;
}
break;
}
}
ASSERT(bp->used_size == hp - *hpp);
*hpp = hp;
if (is_not_immed(token)) {
ASSERT(in_heapfrag(ptr_val(token), bp));
ERL_MESSAGE_TOKEN(msg) = offset_ptr(token, offs);
#ifdef HARD_DEBUG
ASSERT(dbg_thp_start <= ptr_val(ERL_MESSAGE_TOKEN(msg)));
ASSERT(hp > ptr_val(ERL_MESSAGE_TOKEN(msg)));
#endif
}
if (is_not_immed(term)) {
ASSERT(in_heapfrag(ptr_val(term),bp));
ERL_MESSAGE_TERM(msg) = offset_ptr(term, offs);
#ifdef HARD_DEBUG
ASSERT(dbg_thp_start <= ptr_val(ERL_MESSAGE_TERM(msg)));
ASSERT(hp > ptr_val(ERL_MESSAGE_TERM(msg)));
#endif
}
#ifdef USE_VM_PROBES
if (is_not_immed(utag)) {
ASSERT(in_heapfrag(ptr_val(utag), bp));
ERL_MESSAGE_DT_UTAG(msg) = offset_ptr(utag, offs);
#ifdef HARD_DEBUG
ASSERT(dbg_thp_start <= ptr_val(ERL_MESSAGE_DT_UTAG(msg)));
ASSERT(hp > ptr_val(ERL_MESSAGE_DT_UTAG(msg)));
#endif
}
#endif
copy_done:
#ifdef HARD_DEBUG
{
int i, j;
ErlHeapFragment* frag;
{
struct erl_off_heap_header* dbg_oh = off_heap->first;
i = j = 0;
while (dbg_oh != dbg_oh_start) {
dbg_oh = dbg_oh->next;
i++;
}
for (frag=bp; frag; frag=frag->next) {
dbg_oh = frag->off_heap.first;
while (dbg_oh) {
dbg_oh = dbg_oh->next;
j++;
}
}
ASSERT(i == j);
}
}
#endif
bp->off_heap.first = NULL;
free_message_buffer(bp);
msg->data.heap_frag = NULL;
#ifdef HARD_DEBUG
ASSERT(eq(ERL_MESSAGE_TERM(msg), dbg_term));
ASSERT(eq(ERL_MESSAGE_TOKEN(msg), dbg_token));
#ifdef USE_VM_PROBES
ASSERT(eq(ERL_MESSAGE_DT_UTAG(msg), dbg_utag));
#endif
free_message_buffer(dbg_bp);
#endif
}
/*
* Copy a term that is guaranteed to be contained in a single
* heap block. The heap block is copied word by word, and any
* pointers are offsetted to point correctly in the new location.
*
* Typically used to copy a term from an ets table.
*
* NOTE: Assumes that term is a tuple (ptr is an untagged tuple ptr).
*/
Eterm
copy_shallow(Eterm* ptr, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
{
Eterm* tp = ptr;
Eterm* hp = *hpp;
Sint offs = hp - tp;
while (sz--) {
Eterm val = *tp++;
switch (primary_tag(val)) {
case TAG_PRIMARY_IMMED1:
*hp++ = val;
break;
case TAG_PRIMARY_LIST:
case TAG_PRIMARY_BOXED:
*hp++ = offset_ptr(val, offs);
break;
case TAG_PRIMARY_HEADER:
*hp++ = val;
switch (val & _HEADER_SUBTAG_MASK) {
case ARITYVAL_SUBTAG:
break;
case REFC_BINARY_SUBTAG:
{
ProcBin* pb = (ProcBin *) (hp-1);
int tari = thing_arityval(val);
sz -= tari;
while (tari--) {
*hp++ = *tp++;
}
erts_refc_inc(&pb->val->refc, 2);
pb->next = off_heap->mso;
off_heap->mso = pb;
off_heap->overhead += pb->size / sizeof(Eterm);
}
break;
case FUN_SUBTAG:
{
#ifndef HYBRID /* FIND ME! */
ErlFunThing* funp = (ErlFunThing *) (hp-1);
#endif
int tari = thing_arityval(val);
sz -= tari;
while (tari--) {
*hp++ = *tp++;
}
#ifndef HYBRID /* FIND ME! */
funp->next = off_heap->funs;
off_heap->funs = funp;
erts_refc_inc(&funp->fe->refc, 2);
#endif
}
break;
case EXTERNAL_PID_SUBTAG:
case EXTERNAL_PORT_SUBTAG:
case EXTERNAL_REF_SUBTAG:
{
ExternalThing* etp = (ExternalThing *) (hp-1);
int tari = thing_arityval(val);
sz -= tari;
while (tari--) {
*hp++ = *tp++;
}
etp->next = off_heap->externals;
off_heap->externals = etp;
erts_refc_inc(&etp->node->refc, 2);
}
break;
default:
{
int tari = header_arity(val);
sz -= tari;
while (tari--) {
*hp++ = *tp++;
}
}
break;
}
break;
}
}
*hpp = hp;
return make_tuple(ptr + offs);
}
Uint
size_object(Eterm obj)
{
Uint sum = 0;
Eterm* ptr;
int arity;
DECLARE_ESTACK(s);
for (;;) {
switch (primary_tag(obj)) {
case TAG_PRIMARY_LIST:
sum += 2;
ptr = list_val(obj);
obj = *ptr++;
if (!IS_CONST(obj)) {
ESTACK_PUSH(s, obj);
}
obj = *ptr;
break;
case TAG_PRIMARY_BOXED:
{
Eterm hdr = *boxed_val(obj);
ASSERT(is_header(hdr));
switch (hdr & _TAG_HEADER_MASK) {
case ARITYVAL_SUBTAG:
ptr = tuple_val(obj);
arity = header_arity(hdr);
sum += arity + 1;
if (arity == 0) { /* Empty tuple -- unusual. */
goto pop_next;
}
while (arity-- > 1) {
obj = *++ptr;
if (!IS_CONST(obj)) {
ESTACK_PUSH(s, obj);
}
}
obj = *++ptr;
break;
case FUN_SUBTAG:
{
Eterm* bptr = fun_val(obj);
ErlFunThing* funp = (ErlFunThing *) bptr;
unsigned eterms = 1 /* creator */ + funp->num_free;
unsigned sz = thing_arityval(hdr);
sum += 1 /* header */ + sz + eterms;
bptr += 1 /* header */ + sz;
while (eterms-- > 1) {
obj = *bptr++;
if (!IS_CONST(obj)) {
ESTACK_PUSH(s, obj);
}
}
obj = *bptr;
break;
}
case SUB_BINARY_SUBTAG:
{
Eterm real_bin;
Uint offset; /* Not used. */
Uint bitsize;
Uint bitoffs;
Uint extra_bytes;
Eterm hdr;
ERTS_GET_REAL_BIN(obj, real_bin, offset, bitoffs, bitsize);
if ((bitsize + bitoffs) > 8) {
sum += ERL_SUB_BIN_SIZE;
extra_bytes = 2;
} else if ((bitsize + bitoffs) > 0) {
sum += ERL_SUB_BIN_SIZE;
extra_bytes = 1;
} else {
extra_bytes = 0;
}
hdr = *binary_val(real_bin);
if (thing_subtag(hdr) == REFC_BINARY_SUBTAG) {
sum += PROC_BIN_SIZE;
} else {
sum += heap_bin_size(binary_size(obj)+extra_bytes);
}
goto pop_next;
}
break;
case BIN_MATCHSTATE_SUBTAG:
erl_exit(ERTS_ABORT_EXIT,
"size_object: matchstate term not allowed");
default:
sum += thing_arityval(hdr) + 1;
goto pop_next;
}
}
break;
case TAG_PRIMARY_IMMED1:
pop_next:
if (ESTACK_ISEMPTY(s)) {
DESTROY_ESTACK(s);
return sum;
}
obj = ESTACK_POP(s);
break;
default:
erl_exit(ERTS_ABORT_EXIT, "size_object: bad tag for %#x\n", obj);
}
}
}
/* Copy a message to the message area. */
Eterm copy_struct_lazy(Process *from, Eterm orig, Uint offs)
{
Eterm obj;
Eterm dest;
#ifdef INCREMENTAL
int alloc_old = 0;
#else
int total_need = 0;
#endif
VERBOSE(DEBUG_MESSAGES,
("COPY START; %T is sending a message @ 0x%016x\n%T\n",
from->id, orig, orig));
#ifndef INCREMENTAL
copy_start:
#endif
MA_STACK_PUSH(src,orig);
MA_STACK_PUSH(dst,&dest);
MA_STACK_PUSH(offset,offs);
while (ma_src_top > 0) {
obj = MA_STACK_POP(src);
/* copy_struct_lazy should never be called with something that
* do not need to be copied. Within the loop, nothing that do
* not need copying should be placed in the src-stack.
*/
ASSERT(!NO_COPY(obj));
switch (primary_tag(obj)) {
case TAG_PRIMARY_LIST: {
Eterm *hp;
Eterm *objp;
GlobalAlloc(from,2,hp);
objp = list_val(obj);
MA_STACK_UPDATE(dst,MA_STACK_POP(offset),make_list(hp));
MA_STACK_POP(dst);
/* TODO: Byt ordningen nedan så att CDR pushas först. */
if (NO_COPY(*objp)) {
hp[0] = *objp;
#ifdef INCREMENTAL
if (ptr_within(ptr_val(*objp),inc_fromspc,inc_fromend))
INC_STORE(gray,hp,2);
#endif
} else {
MA_STACK_PUSH(src,*objp);
MA_STACK_PUSH(dst,hp);
MA_STACK_PUSH(offset,0);
}
objp++;
if (NO_COPY(*objp)) {
hp[1] = *objp;
#ifdef INCREMENTAL
if (ptr_within(ptr_val(*objp),inc_fromspc,inc_fromend))
INC_STORE(gray,hp,2);
#endif
}
else {
MA_STACK_PUSH(src,*objp);
MA_STACK_PUSH(dst,hp);
MA_STACK_PUSH(offset,1);
}
continue;
}
case TAG_PRIMARY_BOXED: {
Eterm *objp = boxed_val(obj);
switch (*objp & _TAG_HEADER_MASK) {
case ARITYVAL_SUBTAG: {
Uint ari = arityval(*objp);
Uint i;
Eterm *hp;
GlobalAlloc(from,ari + 1,hp);
/* A GC above might invalidate the value of objp */
objp = boxed_val(obj);
MA_STACK_UPDATE(dst,MA_STACK_POP(offset),make_tuple(hp));
MA_STACK_POP(dst);
*hp = *objp++;
for (i = 1; i <= ari; i++) {
switch (primary_tag(*objp)) {
case TAG_PRIMARY_LIST:
case TAG_PRIMARY_BOXED:
if (NO_COPY(*objp)) {
hp[i] = *objp;
#ifdef INCREMENTAL
if (ptr_within(ptr_val(*objp),
inc_fromspc,inc_fromend))
INC_STORE(gray,hp,BOXED_NEED(hp,*hp));
#endif
objp++;
} else {
MA_STACK_PUSH(src,*objp++);
MA_STACK_PUSH(dst,hp);
MA_STACK_PUSH(offset,i);
}
break;
default:
hp[i] = *objp++;
}
}
continue;
}
case REFC_BINARY_SUBTAG: {
ProcBin *pb;
Uint i = thing_arityval(*objp) + 1;
Eterm *hp;
GlobalAlloc(from,i,hp);
/* A GC above might invalidate the value of objp */
objp = boxed_val(obj);
MA_STACK_UPDATE(dst,MA_STACK_POP(offset),make_binary(hp));
MA_STACK_POP(dst);
pb = (ProcBin*) hp;
while (i--) {
*hp++ = *objp++;
}
erts_refc_inc(&pb->val->refc, 2);
pb->next = erts_global_offheap.mso;
erts_global_offheap.mso = pb;
erts_global_offheap.overhead += pb->size / sizeof(Eterm);
continue;
}
case FUN_SUBTAG: {
ErlFunThing *funp = (ErlFunThing*) objp;
Uint i = thing_arityval(*objp) + 1;
Uint j = i + 1 + funp->num_free;
Uint k = i;
Eterm *hp, *hp_start;
GlobalAlloc(from,j,hp);
/* A GC above might invalidate the value of objp */
objp = boxed_val(obj);
hp_start = hp;
MA_STACK_UPDATE(dst,MA_STACK_POP(offset),make_fun(hp));
MA_STACK_POP(dst);
funp = (ErlFunThing*) hp;
while (i--) {
*hp++ = *objp++;
}
#ifndef HYBRID // FIND ME!
funp->next = erts_global_offheap.funs;
erts_global_offheap.funs = funp;
erts_refc_inc(&funp->fe->refc, 2);
#endif
for (i = k; i < j; i++) {
switch (primary_tag(*objp)) {
case TAG_PRIMARY_LIST:
case TAG_PRIMARY_BOXED:
if (NO_COPY(*objp)) {
#ifdef INCREMENTAL
if (ptr_within(ptr_val(*objp),
inc_fromspc,inc_fromend))
INC_STORE(gray,hp,BOXED_NEED(hp,*hp));
#endif
*hp++ = *objp++;
} else {
MA_STACK_PUSH(src,*objp++);
MA_STACK_PUSH(dst,hp_start);
MA_STACK_PUSH(offset,i);
hp++;
}
break;
default:
*hp++ = *objp++;
}
}
continue;
}
case EXTERNAL_PID_SUBTAG:
case EXTERNAL_PORT_SUBTAG:
case EXTERNAL_REF_SUBTAG: {
ExternalThing *etp;
Uint i = thing_arityval(*objp) + 1;
Eterm *hp;
GlobalAlloc(from,i,hp);
/* A GC above might invalidate the value of objp */
objp = boxed_val(obj);
MA_STACK_UPDATE(dst,MA_STACK_POP(offset),make_external(hp));
MA_STACK_POP(dst);
etp = (ExternalThing*) hp;
while (i--) {
*hp++ = *objp++;
}
etp->next = erts_global_offheap.externals;
erts_global_offheap.externals = etp;
erts_refc_inc(&etp->node->refc, 2);
continue;
}
case SUB_BINARY_SUBTAG: {
ErlSubBin *sb = (ErlSubBin *) objp;
Eterm *hp;
Eterm res_binary;
Eterm real_bin = sb->orig;
Uint bit_offset = sb->bitoffs;
Uint bit_size = sb -> bitsize;
Uint sub_offset = sb->offs;
size_t size = sb->size;
Uint extra_bytes;
Uint real_size;
Uint sub_binary_heapneed;
if ((bit_size + bit_offset) > 8) {
extra_bytes = 2;
sub_binary_heapneed = ERL_SUB_BIN_SIZE;
} else if ((bit_size + bit_offset) > 0) {
extra_bytes = 1;
sub_binary_heapneed = ERL_SUB_BIN_SIZE;
} else {
extra_bytes = 0;
sub_binary_heapneed = 0;
}
real_size = size+extra_bytes;
objp = binary_val(real_bin);
if (thing_subtag(*objp) == HEAP_BINARY_SUBTAG) {
ErlHeapBin *from_bin;
ErlHeapBin *to_bin;
Uint i = heap_bin_size(real_size);
GlobalAlloc(from,i+sub_binary_heapneed,hp);
from_bin = (ErlHeapBin *) objp;
to_bin = (ErlHeapBin *) hp;
to_bin->thing_word = header_heap_bin(real_size);
to_bin->size = real_size;
sys_memcpy(to_bin->data, ((byte *)from_bin->data) +
sub_offset, real_size);
res_binary = make_binary(to_bin);
hp += i;
} else {
ProcBin *from_bin;
ProcBin *to_bin;
ASSERT(thing_subtag(*objp) == REFC_BINARY_SUBTAG);
from_bin = (ProcBin *) objp;
erts_refc_inc(&from_bin->val->refc, 2);
GlobalAlloc(from,PROC_BIN_SIZE+sub_binary_heapneed,hp);
to_bin = (ProcBin *) hp;
to_bin->thing_word = HEADER_PROC_BIN;
to_bin->size = real_size;
to_bin->val = from_bin->val;
to_bin->bytes = from_bin->bytes + sub_offset;
to_bin->next = erts_global_offheap.mso;
erts_global_offheap.mso = to_bin;
erts_global_offheap.overhead += to_bin->size / sizeof(Eterm);
res_binary=make_binary(to_bin);
hp += PROC_BIN_SIZE;
}
if (extra_bytes != 0) {
ErlSubBin* res;
res = (ErlSubBin *) hp;
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 = res_binary;
res_binary = make_binary(hp);
}
MA_STACK_UPDATE(dst,MA_STACK_POP(offset),res_binary);
MA_STACK_POP(dst);
continue;
}
case BIN_MATCHSTATE_SUBTAG:
erl_exit(ERTS_ABORT_EXIT,
"copy_struct_lazy: matchstate term not allowed");
default: {
Uint size = thing_arityval(*objp) + 1;
Eterm *hp;
GlobalAlloc(from,size,hp);
/* A GC above might invalidate the value of objp */
objp = boxed_val(obj);
MA_STACK_UPDATE(dst,MA_STACK_POP(offset),make_boxed(hp));
MA_STACK_POP(dst);
while (size--) {
*hp++ = *objp++;
}
continue;
}
}
continue;
}
case TAG_PRIMARY_HEADER:
ASSERT((obj & _TAG_HEADER_MASK) == ARITYVAL_SUBTAG);
{
Eterm *objp = &obj;
Uint ari = arityval(obj);
Uint i;
Eterm *hp;
GlobalAlloc(from,ari + 1,hp);
MA_STACK_UPDATE(dst,MA_STACK_POP(offset),make_tuple(hp));
MA_STACK_POP(dst);
*hp = *objp++;
for (i = 1; i <= ari; i++) {
switch (primary_tag(*objp)) {
case TAG_PRIMARY_LIST:
case TAG_PRIMARY_BOXED:
if (NO_COPY(*objp)) {
#ifdef INCREMENTAL
if (ptr_within(ptr_val(*objp),inc_fromspc,inc_fromend))
INC_STORE(gray,hp,ari + 1);
#endif
hp[i] = *objp++;
} else {
MA_STACK_PUSH(src,*objp++);
MA_STACK_PUSH(dst,hp);
MA_STACK_PUSH(offset,i);
}
break;
default:
hp[i] = *objp++;
}
}
continue;
}
default:
erl_exit(ERTS_ABORT_EXIT,
"%s, line %d: Internal error in copy_struct_lazy: 0x%08x\n",
__FILE__, __LINE__,obj);
}
}
VERBOSE(DEBUG_MESSAGES,
("Copy allocated @ 0x%08lx:\n%T\n",
(unsigned long)ptr_val(dest),dest));
ma_gc_flags &= ~GC_CYCLE_START;
ASSERT(eq(orig, dest));
ASSERT(ma_src_top == 0);
ASSERT(ma_dst_top == 0);
ASSERT(ma_offset_top == 0);
return dest;
}
/*
* 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 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;
}
Eterm copy_shallow(Eterm* ptr, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
#endif
{
Eterm* tp = ptr;
Eterm* hp = *hpp;
const Eterm res = make_tuple(hp);
#if HALFWORD_HEAP
const Sint offs = COMPRESS_POINTER(hp - (tp - src_base));
#else
const Sint offs = (hp - tp) * sizeof(Eterm);
#endif
while (sz--) {
Eterm val = *tp++;
switch (primary_tag(val)) {
case TAG_PRIMARY_IMMED1:
*hp++ = val;
break;
case TAG_PRIMARY_LIST:
case TAG_PRIMARY_BOXED:
*hp++ = byte_offset_ptr(val, offs);
break;
case TAG_PRIMARY_HEADER:
*hp++ = val;
switch (val & _HEADER_SUBTAG_MASK) {
case ARITYVAL_SUBTAG:
break;
case REFC_BINARY_SUBTAG:
{
ProcBin* pb = (ProcBin *) (tp-1);
erts_refc_inc(&pb->val->refc, 2);
OH_OVERHEAD(off_heap, pb->size / sizeof(Eterm));
}
goto off_heap_common;
case FUN_SUBTAG:
{
ErlFunThing* funp = (ErlFunThing *) (tp-1);
erts_refc_inc(&funp->fe->refc, 2);
}
goto off_heap_common;
case MAP_SUBTAG:
*hp++ = *tp++;
sz--;
break;
case EXTERNAL_PID_SUBTAG:
case EXTERNAL_PORT_SUBTAG:
case EXTERNAL_REF_SUBTAG:
{
ExternalThing* etp = (ExternalThing *) (tp-1);
erts_refc_inc(&etp->node->refc, 2);
}
off_heap_common:
{
struct erl_off_heap_header* ohh = (struct erl_off_heap_header*)(hp-1);
int tari = thing_arityval(val);
sz -= tari;
while (tari--) {
*hp++ = *tp++;
}
ohh->next = off_heap->first;
off_heap->first = ohh;
}
break;
default:
{
int tari = header_arity(val);
sz -= tari;
while (tari--) {
*hp++ = *tp++;
}
}
break;
}
break;
}
}
*hpp = hp;
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;
}
