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 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; }
static int any_heap_refs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size) { Eterm* p; Eterm val; for (p = start; p < end; p++) { val = *p; switch (primary_tag(val)) { case TAG_PRIMARY_BOXED: case TAG_PRIMARY_LIST: if (in_area(val, mod_start, mod_size)) { return 1; } break; case TAG_PRIMARY_HEADER: if (!header_is_transparent(val)) { Eterm* new_p = p + thing_arityval(val); ASSERT(start <= new_p && new_p < end); p = new_p; } } } return 0; }
static int any_heap_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; }
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)); } }
/* * 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); }
/* 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 int any_heap_ref_ptrs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size) { Eterm* p; Eterm val; for (p = start; p < end; p++) { val = *p; switch (primary_tag(val)) { case TAG_PRIMARY_BOXED: case TAG_PRIMARY_LIST: if (ErtsInArea(val, mod_start, mod_size)) { return 1; } break; } } return 0; }
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; } } } }
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; }
/* * 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; }
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); } } }
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; }
/* * 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 }
int is_term_smaller(term_t a, term_t b) { if (a == b) return 0; if (are_both_immed(a, b)) { if (are_both_int(a, b)) return int_value(a) < int_value(b); if (is_int(a)) // !is_int(b) return 1; if (is_nil(a)) // !is_nil(b) return 0; if (is_nil(b)) // !is_nil(a) return 1; if (is_atom(a)) { if (is_int(b)) return 0; else if (is_atom(b)) { uint8_t *print1 = atoms_get(atom_index(a)); uint8_t *print2 = atoms_get(atom_index(b)); int short_len = (print1[0] < print2[0]) ? print1[0] : print2[0]; int d = memcmp(print1+1, print2+1, short_len); if (d == 0) return print1[0] < print2[0]; return d < 0; } else return 1; } else if (is_short_oid(a)) { if (is_int(b) || is_atom(b)) return 0; else if (is_short_oid(b)) return short_oid_id(a) < short_oid_id(b); else return 1; } else if (is_short_pid(a)) { if (is_int(b) || is_atom(b) || is_short_oid(b)) return 0; else { assert(is_short_pid(b)); return short_pid_id(a) < short_pid_id(b); } } } //TODO: comparison of bignum and float: docs mention the // number 9007199254740992.0 and a loss of transitivity if (!is_immed(a) && !is_immed(b) && primary_tag(a) == primary_tag(b)) { if (is_cons(a)) return is_term_smaller_1(a, b); else if (is_tuple(a)) return is_term_smaller_2(a, b); else { assert(is_boxed(a) && is_boxed(b)); uint32_t *adata = peel_boxed(a); uint32_t *bdata = peel_boxed(b); if (boxed_tag(adata) == boxed_tag(bdata) || (is_binary(adata) && is_binary(bdata)) || (is_bignum(adata) && is_bignum(bdata))) { switch(boxed_tag(adata)) { case SUBTAG_POS_BIGNUM: case SUBTAG_NEG_BIGNUM: return bignum_compare((bignum_t *)adata, (bignum_t *)bdata) < 0; case SUBTAG_FUN: return fun_compare((t_fun_t *)adata, (t_fun_t *)bdata) < 0; case SUBTAG_EXPORT: return export_compare((t_export_t *)adata, (t_export_t *)bdata) < 0; case SUBTAG_PID: return pid_compare((t_long_pid_t *)adata, (t_long_pid_t *)bdata) < 0; case SUBTAG_OID: return oid_compare((t_long_oid_t *)adata, (t_long_oid_t *)bdata) < 0; case SUBTAG_REF: return ref_compare((t_long_ref_t *)adata, (t_long_ref_t *)bdata) < 0; case SUBTAG_PROC_BIN: case SUBTAG_HEAP_BIN: case SUBTAG_MATCH_CTX: case SUBTAG_SUB_BIN: return is_term_smaller_3(adata, bdata); default: assert(boxed_tag(adata) == SUBTAG_FLOAT); return float_value(adata) < float_value(bdata); } } } } // Number comparison with (mandatory) coercion // int use_float = (is_boxed(a) && boxed_tag(peel_boxed(a)) == SUBTAG_FLOAT) || (is_boxed(b) && boxed_tag(peel_boxed(b)) == SUBTAG_FLOAT); if (use_float) { if (is_int(a)) // b is always float return (double)int_value(a) < float_value(peel_boxed(b)); else if (is_boxed(a)) { uint32_t *adata = peel_boxed(a); if (is_bignum(adata)) // b is always float return bignum_to_double((bignum_t *)adata) < float_value(peel_boxed(b)); if (boxed_tag(adata) == SUBTAG_FLOAT) { if (is_int(b)) return float_value(adata) < (double)int_value(b); if (is_boxed(b)) { uint32_t *bdata = peel_boxed(b); if (is_bignum(bdata)) return float_value(adata) < bignum_to_double((bignum_t *)bdata); } } } } else // use integer { if (is_int(a)) { if (is_boxed(b)) { uint32_t *bdata = peel_boxed(b); if (is_bignum(bdata)) { bignum_t *bbn = (bignum_t *)bdata; return !bignum_is_neg(bbn); } assert(boxed_tag(bdata) != SUBTAG_FLOAT); } } else if (is_boxed(a)) { uint32_t *adata = peel_boxed(a); if (is_bignum(adata)) { bignum_t *abn = (bignum_t *)adata; if (is_int(b)) return bignum_is_neg(abn); if (is_boxed(b)) { uint32_t *bdata = peel_boxed(b); if (is_bignum(bdata)) return bignum_compare(abn, (bignum_t *)bdata); assert(boxed_tag(bdata) != SUBTAG_FLOAT); } } assert(boxed_tag(adata) != SUBTAG_FLOAT); } } // a and b are quaranteed to have different types // return term_order(a) < term_order(b); }
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; }
/* * 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 }