static ERTS_INLINE int cmp_mon_ref(Eterm ref1, Eterm ref2)
{
Eterm *b1, *b2;
b1 = boxed_val(ref1);
b2 = boxed_val(ref2);
if (is_ref_thing_header(*b1)) {
if (is_ref_thing_header(*b2)) {
Uint32 *num1, *num2;
if (is_ordinary_ref_thing(b1)) {
ErtsORefThing *rtp = (ErtsORefThing *) b1;
num1 = rtp->num;
}
else {
ErtsMRefThing *mrtp = (ErtsMRefThing *) b1;
num1 = mrtp->mb->refn;
}
if (is_ordinary_ref_thing(b2)) {
ErtsORefThing *rtp = (ErtsORefThing *) b2;
num2 = rtp->num;
}
else {
ErtsMRefThing *mrtp = (ErtsMRefThing *) b2;
num2 = mrtp->mb->refn;
}
return erts_internal_ref_number_cmp(num1, num2);
}
return -1;
}
if (is_ref_thing_header(*b2)) {
return 1;
}
return CMP(ref1,ref2);
}
/*
* 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
dump_element(int to, void *to_arg, Eterm x)
{
if (is_list(x)) {
erts_print(to, to_arg, "H" WORD_FMT, list_val(x));
} else if (is_boxed(x)) {
erts_print(to, to_arg, "H" WORD_FMT, boxed_val(x));
} else if (is_immed(x)) {
if (is_atom(x)) {
unsigned char* s = atom_tab(atom_val(x))->name;
int len = atom_tab(atom_val(x))->len;
int i;
erts_print(to, to_arg, "A%X:", atom_tab(atom_val(x))->len);
for (i = 0; i < len; i++) {
erts_putc(to, to_arg, *s++);
}
} else if (is_small(x)) {
erts_print(to, to_arg, "I%T", x);
} else if (is_pid(x)) {
erts_print(to, to_arg, "P%T", x);
} else if (is_port(x)) {
erts_print(to, to_arg, "p<%bpu.%bpu>",
port_channel_no(x), port_number(x));
} else if (is_nil(x)) {
erts_putc(to, to_arg, 'N');
}
}
}
static int verify_eterm(Process *p,Eterm element)
{
Eterm *ptr;
ErlHeapFragment* mbuf;
switch (primary_tag(element)) {
case TAG_PRIMARY_LIST:
ptr = list_val(element);
break;
case TAG_PRIMARY_BOXED:
ptr = boxed_val(element);
break;
default: /* Immediate or header/cp */
return 1;
}
if (p) {
if (IN_HEAP(p, ptr))
return 1;
for (mbuf = p->mbuf; mbuf; mbuf = mbuf->next) {
if (WITHIN(ptr, &mbuf->mem[0], &mbuf->mem[0] + mbuf->used_size)) {
return 1;
}
}
}
return 0;
}
static void
print_lock2(char *prefix, Sint16 id, Eterm extra, Uint16 flags, char *suffix)
{
char *lname = (0 <= id && id < ERTS_LOCK_ORDER_SIZE
? erts_lock_order[id].name
: "unknown");
if (is_boxed(extra))
erts_fprintf(stderr,
"%s'%s:%p%s'%s%s",
prefix,
lname,
boxed_val(extra),
lock_type(flags),
rw_op_str(flags),
suffix);
else
erts_fprintf(stderr,
"%s'%s:%T%s'%s%s",
prefix,
lname,
extra,
lock_type(flags),
rw_op_str(flags),
suffix);
}
static ERTS_INLINE int cmp_mon_ref(Eterm ref1, Eterm ref2)
{
Eterm *b1, *b2;
b1 = boxed_val(ref1);
b2 = boxed_val(ref2);
if (is_ref_thing_header(*b1)) {
if (is_ref_thing_header(*b2)) {
return memcmp(b1+1,b2+1,ERTS_REF_WORDS*sizeof(Uint));
}
return -1;
}
if (is_ref_thing_header(*b2)) {
return 1;
}
return CMP(ref1,ref2);
}
void erts_check_stack(Process *p)
{
Eterm *elemp;
Eterm *stack_start = p->heap + p->heap_sz;
Eterm *stack_end = p->htop;
if (p->stop > stack_start)
erl_exit(1,
"<%lu.%lu.%lu>: Stack underflow\n",
internal_pid_channel_no(p->common.id),
internal_pid_number(p->common.id),
internal_pid_serial(p->common.id));
if (p->stop < stack_end)
erl_exit(1,
"<%lu.%lu.%lu>: Stack overflow\n",
internal_pid_channel_no(p->common.id),
internal_pid_number(p->common.id),
internal_pid_serial(p->common.id));
for (elemp = p->stop; elemp < stack_start; elemp++) {
int in_mbuf = 0;
Eterm *ptr;
ErlHeapFragment* mbuf;
switch (primary_tag(*elemp)) {
case TAG_PRIMARY_LIST:
ptr = list_val(*elemp);
break;
case TAG_PRIMARY_BOXED:
ptr = boxed_val(*elemp);
break;
default: /* Immediate or cp */
continue;
}
if (IN_HEAP(p, ptr))
continue;
for (mbuf = p->mbuf; mbuf; mbuf = mbuf->next)
if (WITHIN(ptr, &mbuf->mem[0], &mbuf->mem[0] + mbuf->used_size)) {
in_mbuf = 1;
break;
}
if (in_mbuf)
continue;
erl_exit(1,
"<%lu.%lu.%lu>: Wild stack pointer\n",
internal_pid_channel_no(p->common.id),
internal_pid_number(p->common.id),
internal_pid_serial(p->common.id));
}
}
/* 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]);
}
}
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);
}
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;
}
BIF_RETTYPE persistent_term_put_2(BIF_ALIST_2)
{
static const Uint ITERATIONS_PER_RED = 32;
ErtsPersistentTermPut2Context* ctx;
Eterm state_mref = THE_NON_VALUE;
long iterations_until_trap;
long max_iterations;
#define PUT_TRAP_CODE \
BIF_TRAP2(bif_export[BIF_persistent_term_put_2], BIF_P, state_mref, BIF_ARG_2)
#define TRAPPING_COPY_TABLE_PUT(TABLE_DEST, OLD_TABLE, NEW_SIZE, COPY_TYPE, LOC_NAME) \
TRAPPING_COPY_TABLE(TABLE_DEST, OLD_TABLE, NEW_SIZE, COPY_TYPE, LOC_NAME, PUT_TRAP_CODE)
#ifdef DEBUG
(void)ITERATIONS_PER_RED;
iterations_until_trap = max_iterations =
GET_SMALL_RANDOM_INT(ERTS_BIF_REDS_LEFT(BIF_P) + (Uint)&ctx);
#else
iterations_until_trap = max_iterations =
ITERATIONS_PER_RED * ERTS_BIF_REDS_LEFT(BIF_P);
#endif
if (is_internal_magic_ref(BIF_ARG_1) &&
(ERTS_MAGIC_BIN_DESTRUCTOR(erts_magic_ref2bin(BIF_ARG_1)) ==
persistent_term_put_2_ctx_bin_dtor)) {
/* Restore state after a trap */
Binary* state_bin;
state_mref = BIF_ARG_1;
state_bin = erts_magic_ref2bin(state_mref);
ctx = ERTS_MAGIC_BIN_DATA(state_bin);
ASSERT(BIF_P->flags & F_DISABLE_GC);
erts_set_gc_state(BIF_P, 1);
switch (ctx->trap_location) {
case PUT2_TRAP_LOCATION_NEW_KEY:
goto L_PUT2_TRAP_LOCATION_NEW_KEY;
case PUT2_TRAP_LOCATION_REPLACE_VALUE:
goto L_PUT2_TRAP_LOCATION_REPLACE_VALUE;
}
} else {
/* Save state in magic bin in case trapping is necessary */
Eterm* hp;
Binary* state_bin = erts_create_magic_binary(sizeof(ErtsPersistentTermPut2Context),
persistent_term_put_2_ctx_bin_dtor);
hp = HAlloc(BIF_P, ERTS_MAGIC_REF_THING_SIZE);
state_mref = erts_mk_magic_ref(&hp, &MSO(BIF_P), state_bin);
ctx = ERTS_MAGIC_BIN_DATA(state_bin);
/*
* IMPORTANT: The following field is used to detect if
* persistent_term_put_2_ctx_bin_dtor needs to free memory
*/
ctx->cpy_ctx.new_table = NULL;
}
if (!try_seize_update_permission(BIF_P)) {
ERTS_BIF_YIELD2(bif_export[BIF_persistent_term_put_2],
BIF_P, BIF_ARG_1, BIF_ARG_2);
}
ctx->hash_table = (HashTable *) erts_atomic_read_nob(&the_hash_table);
ctx->key = BIF_ARG_1;
ctx->term = BIF_ARG_2;
ctx->entry_index = lookup(ctx->hash_table, ctx->key);
ctx->heap[0] = make_arityval(2);
ctx->heap[1] = ctx->key;
ctx->heap[2] = ctx->term;
ctx->tuple = make_tuple(ctx->heap);
if (is_nil(ctx->hash_table->term[ctx->entry_index])) {
Uint new_size = ctx->hash_table->allocated;
if (MUST_GROW(ctx->hash_table)) {
new_size *= 2;
}
TRAPPING_COPY_TABLE_PUT(ctx->hash_table,
ctx->hash_table,
new_size,
ERTS_PERSISTENT_TERM_CPY_NO_REHASH,
PUT2_TRAP_LOCATION_NEW_KEY);
ctx->entry_index = lookup(ctx->hash_table, ctx->key);
ctx->hash_table->num_entries++;
} else {
Eterm tuple = ctx->hash_table->term[ctx->entry_index];
Eterm old_term;
ASSERT(is_tuple_arity(tuple, 2));
old_term = boxed_val(tuple)[2];
if (EQ(ctx->term, old_term)) {
/* Same value. No need to update anything. */
release_update_permission(0);
BIF_RET(am_ok);
} else {
/* Mark the old term for deletion. */
mark_for_deletion(ctx->hash_table, ctx->entry_index);
TRAPPING_COPY_TABLE_PUT(ctx->hash_table,
ctx->hash_table,
ctx->hash_table->allocated,
ERTS_PERSISTENT_TERM_CPY_NO_REHASH,
PUT2_TRAP_LOCATION_REPLACE_VALUE);
}
}
{
Uint term_size;
Uint lit_area_size;
ErlOffHeap code_off_heap;
ErtsLiteralArea* literal_area;
erts_shcopy_t info;
Eterm* ptr;
/*
* Preserve internal sharing in the term by using the
* sharing-preserving functions. However, literals must
* be copied in case the module holding them are unloaded.
*/
INITIALIZE_SHCOPY(info);
info.copy_literals = 1;
term_size = copy_shared_calculate(ctx->tuple, &info);
ERTS_INIT_OFF_HEAP(&code_off_heap);
lit_area_size = ERTS_LITERAL_AREA_ALLOC_SIZE(term_size);
literal_area = erts_alloc(ERTS_ALC_T_LITERAL, lit_area_size);
ptr = &literal_area->start[0];
literal_area->end = ptr + term_size;
ctx->tuple = copy_shared_perform(ctx->tuple, term_size, &info, &ptr, &code_off_heap);
ASSERT(tuple_val(ctx->tuple) == literal_area->start);
literal_area->off_heap = code_off_heap.first;
DESTROY_SHCOPY(info);
erts_set_literal_tag(&ctx->tuple, literal_area->start, term_size);
ctx->hash_table->term[ctx->entry_index] = ctx->tuple;
erts_schedule_thr_prgr_later_op(table_updater, ctx->hash_table, &thr_prog_op);
suspend_updater(BIF_P);
}
BUMP_REDS(BIF_P, (max_iterations - iterations_until_trap) / ITERATIONS_PER_RED);
ERTS_BIF_YIELD_RETURN(BIF_P, am_ok);
}
