Пример #1
0
void
erts_cleanup_offheap(ErlOffHeap *offheap)
{
    union erl_off_heap_ptr u;

    for (u.hdr = offheap->first; u.hdr; u.hdr = u.hdr->next) {
	switch (thing_subtag(u.hdr->thing_word)) {
	case REFC_BINARY_SUBTAG:
            erts_bin_release(u.pb->val);
	    break;
	case FUN_SUBTAG:
	    if (erts_refc_dectest(&u.fun->fe->refc, 0) == 0) {
		erts_erase_fun_entry(u.fun->fe);		    
	    }
	    break;
	case REF_SUBTAG:
	    ASSERT(is_magic_ref_thing(u.hdr));
            erts_bin_release((Binary *)u.mref->mb);
	    break;
	default:
	    ASSERT(is_external_header(u.hdr->thing_word));
	    erts_deref_node_entry(u.ext->node);
	    break;
	}
    }
}
Пример #2
0
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);
}
Пример #3
0
static void
insert_offheap(ErlOffHeap *oh, int type, Eterm id)
{
    union erl_off_heap_ptr u;
    struct insert_offheap2_arg a;
    a.type = BIN_REF;

    for (u.hdr = oh->first; u.hdr; u.hdr = u.hdr->next) {
	switch (thing_subtag(u.hdr->thing_word)) {
	case REFC_BINARY_SUBTAG:
	    if(IsMatchProgBinary(u.pb->val)) {
		InsertedBin *ib;
		int insert_bin = 1;
		for (ib = inserted_bins; ib; ib = ib->next)
		    if(ib->bin_val == u.pb->val) {
			insert_bin = 0;
			break;
		    }
		if (insert_bin) {
#if HALFWORD_HEAP
		    UWord val = (UWord) u.pb->val;
		    DeclareTmpHeapNoproc(id_heap,BIG_UINT_HEAP_SIZE*2); /* extra place allocated */
#else
		    DeclareTmpHeapNoproc(id_heap,BIG_UINT_HEAP_SIZE);
#endif
		    Uint *hp = &id_heap[0];
		    InsertedBin *nib;
#if HALFWORD_HEAP
		    int actual_need = BIG_UWORD_HEAP_SIZE(val);
		    ASSERT(actual_need <= (BIG_UINT_HEAP_SIZE*2));
		    UseTmpHeapNoproc(actual_need);
		    a.id = erts_bld_uword(&hp, NULL, (UWord) val);
#else
		    UseTmpHeapNoproc(BIG_UINT_HEAP_SIZE);
		    a.id = erts_bld_uint(&hp, NULL, (Uint) u.pb->val);
#endif
		    erts_match_prog_foreach_offheap(u.pb->val,
						    insert_offheap2,
						    (void *) &a);
		    nib = erts_alloc(ERTS_ALC_T_NC_TMP, sizeof(InsertedBin));
		    nib->bin_val = u.pb->val;
		    nib->next = inserted_bins;
		    inserted_bins = nib;
#if HALFWORD_HEAP
		    UnUseTmpHeapNoproc(actual_need);
#else
		    UnUseTmpHeapNoproc(BIG_UINT_HEAP_SIZE);
#endif
		}
	    }		
	    break;
	case FUN_SUBTAG:
	    break; /* No need to */
	default:
	    ASSERT(is_external_header(u.hdr->thing_word));
	    insert_node(u.ext->node, type, id);
	    break;
	}
    }
}
Пример #4
0
static ERTS_INLINE int
check_mod_funs(Process *p, ErlOffHeap *off_heap, char *area, size_t area_size)
{
    struct erl_off_heap_header* oh;
    for (oh = off_heap->first; oh; oh = oh->next) {
	if (thing_subtag(oh->thing_word) == FUN_SUBTAG) {
	    ErlFunThing* funp = (ErlFunThing*) oh;
	    if (ErtsInArea(funp->fe->address, area, area_size))
		return !0;
	}
    }
    return 0;
}
Пример #5
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);
}
Пример #6
0
static void
decrement_refc(BeamCodeHeader* code_hdr)
{
    struct erl_off_heap_header* oh = code_hdr->literals_off_heap;

    while (oh) {
	Binary* bptr;
	ASSERT(thing_subtag(oh->thing_word) == REFC_BINARY_SUBTAG);
	bptr = ((ProcBin*)oh)->val;
	if (erts_refc_dectest(&bptr->refc, 0) == 0) {
	    erts_bin_free(bptr);
	}
	oh = oh->next;
    }
}
Пример #7
0
static void
decrement_refc(BeamInstr* code)
{
    struct erl_off_heap_header* oh =
	(struct erl_off_heap_header *) code[MI_LITERALS_OFF_HEAP];

    while (oh) {
	Binary* bptr;
	ASSERT(thing_subtag(oh->thing_word) == REFC_BINARY_SUBTAG);
	bptr = ((ProcBin*)oh)->val;
	if (erts_refc_dectest(&bptr->refc, 0) == 0) {
	    erts_bin_free(bptr);
	}
	oh = oh->next;
    }
}
Пример #8
0
static ERTS_INLINE int
io_list_vec_count(Eterm obj, Uint *v_size,
                  Uint *c_size, Uint *b_size, Uint *in_clist,
                  Uint *p_v_size, Uint *p_c_size, Uint *p_in_clist,
                  Uint blimit)
{
    Uint size = binary_size(obj);
    Eterm real;
    ERTS_DECLARE_DUMMY(Uint offset);
    int bitoffs;
    int bitsize;
    ERTS_GET_REAL_BIN(obj, real, offset, bitoffs, bitsize);
    if (bitsize != 0) return 1;
    if (thing_subtag(*binary_val(real)) == REFC_BINARY_SUBTAG &&
	bitoffs == 0) {
	*b_size += size;
        if (*b_size < size) return 2;
	*in_clist = 0;
        ++*v_size;
        /* If iov_len is smaller then Uint we split the binary into*/
        /* multiple smaller (2GB) elements in the iolist.*/
	*v_size += size / MAX_SYSIOVEC_IOVLEN;
        if (size >= blimit) {
            *p_in_clist = 0;
            ++*p_v_size;
        } else {
            *p_c_size += size;
            if (!*p_in_clist) {
                *p_in_clist = 1;
                ++*p_v_size;
            }
        }
    } else {
	*c_size += size;
        if (*c_size < size) return 2;
	if (!*in_clist) {
	    *in_clist = 1;
	    ++*v_size;
	}
	*p_c_size += size;
	if (!*p_in_clist) {
	    *p_in_clist = 1;
	    ++*p_v_size;
	}
    }
    return 0;
}
Пример #9
0
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);
	}
    }
}
Пример #10
0
/* 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;
}
Пример #11
0
/*
 *  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;
}
Пример #12
0
static Eterm
check_process_code(Process* rp, Module* modp)
{
    BeamInstr* start;
    char* mod_start;
    Uint mod_size;
    BeamInstr* end;
    Eterm* sp;
    struct erl_off_heap_header* oh;
    int done_gc = 0;

#define INSIDE(a) (start <= (a) && (a) < end)

    /*
     * Pick up limits for the module.
     */
    start = modp->old.code;
    end = (BeamInstr *)((char *)start + modp->old.code_length);
    mod_start = (char *) start;
    mod_size = modp->old.code_length;

    /*
     * Check if current instruction or continuation pointer points into module.
     */
    if (INSIDE(rp->i) || INSIDE(rp->cp)) {
	return am_true;
    }

    /*
     * Check all continuation pointers stored on the stack.
     */
    for (sp = rp->stop; sp < STACK_START(rp); sp++) {
	if (is_CP(*sp) && INSIDE(cp_val(*sp))) {
	    return am_true;
	}
    }

    /* 
     * Check all continuation pointers stored in stackdump
     * and clear exception stackdump if there is a pointer
     * to the module.
     */
    if (rp->ftrace != NIL) {
	struct StackTrace *s;
	ASSERT(is_list(rp->ftrace));
	s = (struct StackTrace *) big_val(CDR(list_val(rp->ftrace)));
	if ((s->pc && INSIDE(s->pc)) ||
	    (s->current && INSIDE(s->current))) {
	    rp->freason = EXC_NULL;
	    rp->fvalue = NIL;
	    rp->ftrace = NIL;
	} else {
	    int i;
	    for (i = 0;  i < s->depth;  i++) {
		if (INSIDE(s->trace[i])) {
		    rp->freason = EXC_NULL;
		    rp->fvalue = NIL;
		    rp->ftrace = NIL;
		    break;
		}
	    }
	}
    }

    /*
     * See if there are funs that refer to the old version of the module.
     */

 rescan:
    for (oh = MSO(rp).first; oh; oh = oh->next) {
	if (thing_subtag(oh->thing_word) == FUN_SUBTAG) {
	    ErlFunThing* funp = (ErlFunThing*) oh;

	    if (INSIDE((BeamInstr *) funp->fe->address)) {
		if (done_gc) {
		    return am_true;
		} else {
		    /*
		    * Try to get rid of this fun by garbage collecting.
		    * Clear both fvalue and ftrace to make sure they
		    * don't hold any funs.
		    */
		    rp->freason = EXC_NULL;
		    rp->fvalue = NIL;
		    rp->ftrace = NIL;
		    done_gc = 1;
		    FLAGS(rp) |= F_NEED_FULLSWEEP;
		    (void) erts_garbage_collect(rp, 0, rp->arg_reg, rp->arity);
		    goto rescan;
		}
	    }
	}
    }

    /*
     * See if there are constants inside the module referenced by the process.
     */
    done_gc = 0;
    for (;;) {
	ErlMessage* mp;

	if (any_heap_ref_ptrs(&rp->fvalue, &rp->fvalue+1, mod_start, mod_size)) {
	    rp->freason = EXC_NULL;
	    rp->fvalue = NIL;
	    rp->ftrace = NIL;
	}
	if (any_heap_ref_ptrs(rp->stop, rp->hend, mod_start, mod_size)) {
	    goto need_gc;
	}
	if (any_heap_refs(rp->heap, rp->htop, mod_start, mod_size)) {
	    goto need_gc;
	}

	if (any_heap_refs(rp->old_heap, rp->old_htop, mod_start, mod_size)) {
	    goto need_gc;
	}

	if (rp->dictionary != NULL) {
	    Eterm* start = rp->dictionary->data;
	    Eterm* end = start + rp->dictionary->used;

	    if (any_heap_ref_ptrs(start, end, mod_start, mod_size)) {
		goto need_gc;
	    }
	}

	for (mp = rp->msg.first; mp != NULL; mp = mp->next) {
	    if (any_heap_ref_ptrs(mp->m, mp->m+2, mod_start, mod_size)) {
		goto need_gc;
	    }
	}
	break;

    need_gc:
	if (done_gc) {
	    return am_true;
	} else {
	    Eterm* literals;
	    Uint lit_size;
	    struct erl_off_heap_header* oh;

	    /*
	     * Try to get rid of constants by by garbage collecting.
	     * Clear both fvalue and ftrace.
	     */
	    rp->freason = EXC_NULL;
	    rp->fvalue = NIL;
	    rp->ftrace = NIL;
	    done_gc = 1;
	    FLAGS(rp) |= F_NEED_FULLSWEEP;
	    (void) erts_garbage_collect(rp, 0, rp->arg_reg, rp->arity);
	    literals = (Eterm *) modp->old.code[MI_LITERALS_START];
	    lit_size = (Eterm *) modp->old.code[MI_LITERALS_END] - literals;
	    oh = (struct erl_off_heap_header *)
		modp->old.code[MI_LITERALS_OFF_HEAP];
	    erts_garbage_collect_literals(rp, literals, lit_size, oh);
	}
    }
    return am_false;
#undef INSIDE
}
Пример #13
0
static int iol2v_append_binary(iol2v_state_t *state, Eterm bin_term) {
    int is_acc_small, is_bin_small;
    UWord combined_size;
    UWord binary_size;

    Uint byte_offset, bit_offset, bit_size;
    byte *binary_data;

    Eterm *parent_header;
    Eterm parent_binary;

    ASSERT(state->bytereds_available > state->bytereds_spent);

    ERTS_GET_REAL_BIN(bin_term, parent_binary, byte_offset, bit_offset, bit_size);
    parent_header = binary_val(parent_binary);
    binary_size = binary_size(bin_term);

    if (bit_size != 0) {
        return 0;
    } else if (binary_size == 0) {
        state->bytereds_spent += 1;
        return 1;
    }

    is_acc_small = state->acc_size < IOL2V_SMALL_BIN_LIMIT;
    is_bin_small = binary_size < IOL2V_SMALL_BIN_LIMIT;
    combined_size = binary_size + state->acc_size;

    if (thing_subtag(*parent_header) == REFC_BINARY_SUBTAG) {
        ProcBin *pb = (ProcBin*)parent_header;

        if (pb->flags) {
            erts_emasculate_writable_binary(pb);
        }

        binary_data = &((byte*)pb->bytes)[byte_offset];
    } else {
        ErlHeapBin *hb = (ErlHeapBin*)parent_header;

        ASSERT(thing_subtag(*parent_header) == HEAP_BINARY_SUBTAG);
        ASSERT(is_bin_small);

        binary_data = &((byte*)&hb->data)[byte_offset];
    }

    if (!is_bin_small && (state->acc_size == 0 || !is_acc_small)) {
        /* Avoid combining if we encounter an acceptably large binary while the
         * accumulator is either empty or large enough to be returned on its
         * own. */
        if (state->acc_size != 0) {
            iol2v_enqueue_result(state, iol2v_promote_acc(state));
        }

        iol2v_enqueue_result(state, bin_term);
    } else if (is_bin_small || combined_size < (IOL2V_SMALL_BIN_LIMIT * 2)) {
        /* If the candidate is small or we can't split the combination in two,
         * then just copy it into the accumulator. */
        iol2v_expand_acc(state, binary_size);

        if (ERTS_LIKELY(bit_offset == 0)) {
            sys_memcpy(&(state->acc)->orig_bytes[state->acc_size],
                binary_data, binary_size);
        } else {
            ASSERT(binary_size <= ERTS_UWORD_MAX / 8);

            erts_copy_bits(binary_data, bit_offset, 1,
                (byte*)&(state->acc)->orig_bytes[state->acc_size], 0, 1,
                binary_size * 8);
        }

        state->acc_size += binary_size;
    } else {
        /* Otherwise, append enough data for the accumulator to be valid, and
         * then return the rest as a sub-binary. */
        UWord spill = IOL2V_SMALL_BIN_LIMIT - state->acc_size;
        Eterm binary_tail;

        iol2v_expand_acc(state, spill);

        if (ERTS_LIKELY(bit_offset == 0)) {
            sys_memcpy(&(state->acc)->orig_bytes[state->acc_size],
                binary_data, spill);
        } else {
            ASSERT(binary_size <= ERTS_UWORD_MAX / 8);

            erts_copy_bits(binary_data, bit_offset, 1,
                (byte*)&(state->acc)->orig_bytes[state->acc_size], 0, 1,
                spill * 8);
        }

        state->acc_size += spill;

        binary_tail = iol2v_make_sub_bin(state, bin_term, spill,
            binary_size - spill);

        iol2v_enqueue_result(state, iol2v_promote_acc(state));
        iol2v_enqueue_result(state, binary_tail);
    }

    return 1;
}
Пример #14
0
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);
	}
    }
}
Пример #15
0
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;
}