aboutsummaryrefslogtreecommitdiffstats
path: root/erts
diff options
context:
space:
mode:
Diffstat (limited to 'erts')
-rw-r--r--erts/emulator/beam/copy.c1131
-rw-r--r--erts/emulator/beam/erl_gc.c10
-rw-r--r--erts/emulator/beam/global.h56
3 files changed, 1196 insertions, 1 deletions
diff --git a/erts/emulator/beam/copy.c b/erts/emulator/beam/copy.c
index f27c526413..b31e043f08 100644
--- a/erts/emulator/beam/copy.c
+++ b/erts/emulator/beam/copy.c
@@ -75,8 +75,17 @@ Uint size_object(Eterm obj)
Uint sum = 0;
Eterm* ptr;
int arity;
+#ifdef SHCOPY_DEBUG
+ Eterm mypid;
+#endif
DECLARE_ESTACK(s);
+
+#ifdef SHCOPY_DEBUG
+ mypid = erts_get_current_pid();
+ VERBOSE_DEBUG("[pid=%T] size_object %p\n", mypid, obj);
+#endif
+
for (;;) {
switch (primary_tag(obj)) {
case TAG_PRIMARY_LIST:
@@ -211,6 +220,7 @@ Uint size_object(Eterm obj)
pop_next:
if (ESTACK_ISEMPTY(s)) {
DESTROY_ESTACK(s);
+ VERBOSE_DEBUG("[pid=%T] size was: %u\n", mypid, sum);
return sum;
}
obj = ESTACK_POP(s);
@@ -222,6 +232,350 @@ Uint size_object(Eterm obj)
}
/*
+ * Machinery for sharing preserving information
+ * Using a WSTACK but not very transparently; consider refactoring
+ */
+
+#define DECLARE_BITSTORE(s) \
+ DECLARE_WSTACK(s); \
+ int WSTK_CONCAT(s,_bitoffs) = 0; \
+ int WSTK_CONCAT(s,_offset) = 0; \
+ UWord WSTK_CONCAT(s,_buffer) = 0
+
+#define DESTROY_BITSTORE(s) DESTROY_WSTACK(s)
+#define BITSTORE_PUT(s,i) \
+do { \
+ WSTK_CONCAT(s,_buffer) |= i << WSTK_CONCAT(s,_bitoffs); \
+ WSTK_CONCAT(s,_bitoffs) += 2; \
+ if (WSTK_CONCAT(s,_bitoffs) >= 8*sizeof(UWord)) { \
+ WSTACK_PUSH(s, WSTK_CONCAT(s,_buffer)); \
+ WSTK_CONCAT(s,_bitoffs) = 0; \
+ WSTK_CONCAT(s,_buffer) = 0; \
+ } \
+} while(0)
+#define BITSTORE_CLOSE(s) \
+do { \
+ if (WSTK_CONCAT(s,_bitoffs) > 0) { \
+ WSTACK_PUSH(s, WSTK_CONCAT(s,_buffer)); \
+ WSTK_CONCAT(s,_bitoffs) = 0; \
+ } \
+} while(0)
+
+#define BITSTORE_GET(s) ({ \
+ UWord result; \
+ if (WSTK_CONCAT(s,_bitoffs) <= 0) { \
+ WSTK_CONCAT(s,_buffer) = s.wstart[WSTK_CONCAT(s,_offset)]; \
+ WSTK_CONCAT(s,_offset)++; \
+ WSTK_CONCAT(s,_bitoffs) = 8*sizeof(UWord); \
+ } \
+ WSTK_CONCAT(s,_bitoffs) -= 2; \
+ result = WSTK_CONCAT(s,_buffer) & 3; \
+ WSTK_CONCAT(s,_buffer) >>= 2; \
+ result; \
+})
+
+#define BOXED_VISITED_MASK ((Eterm) 3)
+#define BOXED_VISITED ((Eterm) 1)
+#define BOXED_SHARED_UNPROCESSED ((Eterm) 2)
+#define BOXED_SHARED_PROCESSED ((Eterm) 3)
+
+
+/*
+ * Is an object in the local heap of a process?
+ */
+
+#define INHEAP_SIMPLE(p, ptr) ( \
+ (OLD_HEAP(p) && OLD_HEAP(p) <= ptr && ptr < OLD_HEND(p)) || \
+ (HEAP_START(p) <= ptr && ptr < HEAP_END(p)) \
+ )
+#define INHEAP(p, ptr) ( \
+ INHEAP_SIMPLE(p, ptr) || \
+ (force_local ? (force_local = 0, 1) : 0) \
+ )
+#define COUNT_OFF_HEAP 0
+
+
+/*
+ * Return the real size of an object and find sharing information
+ * This currently returns the same as erts_debug:size/1.
+ * It is argued whether the size of subterms in constant pools
+ * should be counted or not.
+ */
+#if HALFWORD_HEAP
+Uint size_shared_rel(Eterm obj, Eterm* base)
+#else
+Uint size_shared(Eterm obj)
+#endif
+{
+ Eterm saved_obj = obj;
+ Uint sum = 0;
+ Eterm* ptr;
+ Process* myself;
+
+ DECLARE_EQUEUE(s);
+ DECLARE_BITSTORE(b);
+
+ myself = erts_get_current_process();
+ if (myself == NULL)
+ return size_object(obj);
+
+ for (;;) {
+ VERBOSE_DEBUG("[size] visiting: %x ", obj);
+ switch (primary_tag(obj)) {
+ case TAG_PRIMARY_LIST: {
+ Eterm head, tail;
+ VERBOSE_DEBUG("L");
+ ptr = list_val_rel(obj, base);
+ /* we're not counting anything that's outside our heap */
+ if (!COUNT_OFF_HEAP && !INHEAP_SIMPLE(myself, ptr)) {
+ goto pop_next;
+ }
+ head = CAR(ptr);
+ tail = CDR(ptr);
+ /* if it's visited, don't count it */
+ if (primary_tag(tail) == TAG_PRIMARY_HEADER ||
+ primary_tag(head) == TAG_PRIMARY_HEADER) {
+ VERBOSE_DEBUG("!");
+ goto pop_next;
+ }
+ /* else make it visited now */
+ switch (primary_tag(tail)) {
+ case TAG_PRIMARY_LIST:
+ VERBOSE_DEBUG("/L");
+ ptr[1] = (tail - TAG_PRIMARY_LIST) | TAG_PRIMARY_HEADER;
+ break;
+ case TAG_PRIMARY_IMMED1:
+ VERBOSE_DEBUG("/I");
+ CAR(ptr) = (head - primary_tag(head)) | TAG_PRIMARY_HEADER;
+ CDR(ptr) = (tail - TAG_PRIMARY_IMMED1) | primary_tag(head);
+ break;
+ case TAG_PRIMARY_BOXED:
+ VERBOSE_DEBUG("/B saved %d", primary_tag(head));
+ BITSTORE_PUT(b, primary_tag(head));
+ CAR(ptr) = (head - primary_tag(head)) | TAG_PRIMARY_HEADER;
+ CDR(ptr) = (tail - TAG_PRIMARY_BOXED) | TAG_PRIMARY_HEADER;
+ break;
+ }
+ /* and count it */
+ sum += 2;
+ if (!IS_CONST(head)) {
+ EQUEUE_PUT(s, head);
+ }
+ obj = tail;
+ break;
+ }
+ case TAG_PRIMARY_BOXED: {
+ Eterm hdr;
+ VERBOSE_DEBUG("B");
+ ptr = boxed_val_rel(obj, base);
+ /* we're not counting anything that's outside our heap */
+ if (!COUNT_OFF_HEAP && !INHEAP_SIMPLE(myself, ptr)) {
+ goto pop_next;
+ }
+ hdr = *ptr;
+ /* if it's visited, don't count it */
+ if (primary_tag(hdr) != TAG_PRIMARY_HEADER) {
+ VERBOSE_DEBUG("!");
+ goto pop_next;
+ }
+ /* else make it visited now */
+ *ptr = (hdr - primary_tag(hdr)) + BOXED_VISITED;
+ /* and count it */
+ ASSERT(is_header(hdr));
+ switch (hdr & _TAG_HEADER_MASK) {
+ case ARITYVAL_SUBTAG: {
+ int arity = header_arity(hdr);
+ VERBOSE_DEBUG("/T");
+ sum += arity + 1;
+ if (arity == 0) { /* Empty tuple -- unusual. */
+ VERBOSE_DEBUG("e");
+ goto pop_next;
+ }
+ while (arity-- > 0) {
+ obj = *++ptr;
+ if (!IS_CONST(obj)) {
+ EQUEUE_PUT(s, obj);
+ }
+ }
+ goto pop_next;
+ }
+ case FUN_SUBTAG: {
+ ErlFunThing* funp = (ErlFunThing *) ptr;
+ unsigned eterms = 1 /* creator */ + funp->num_free;
+ unsigned sz = thing_arityval(hdr);
+ VERBOSE_DEBUG("/F");
+ sum += 1 /* header */ + sz + eterms;
+ ptr += 1 /* header */ + sz;
+ while (eterms-- > 0) {
+ obj = *ptr++;
+ if (!IS_CONST(obj)) {
+ EQUEUE_PUT(s, obj);
+ }
+ }
+ goto pop_next;
+ }
+ case SUB_BINARY_SUBTAG: {
+ ErlSubBin* sb = (ErlSubBin *) ptr;
+ Uint extra_bytes;
+ Eterm hdr;
+ ASSERT((sb->thing_word & ~BOXED_VISITED_MASK) == HEADER_SUB_BIN);
+ if (sb->bitsize + sb->bitoffs > 8) {
+ sum += ERL_SUB_BIN_SIZE;
+ extra_bytes = 2;
+ } else if (sb->bitsize + sb->bitoffs > 0) {
+ sum += ERL_SUB_BIN_SIZE;
+ extra_bytes = 1;
+ } else {
+ extra_bytes = 0;
+ }
+ ptr = binary_val_rel(sb->orig, base);
+ hdr = (*ptr) & ~BOXED_VISITED_MASK;
+ if (thing_subtag(hdr) == REFC_BINARY_SUBTAG) {
+ sum += PROC_BIN_SIZE;
+ } else {
+ ASSERT(thing_subtag(hdr) == HEAP_BINARY_SUBTAG);
+ sum += heap_bin_size(binary_size_rel(obj, base) + extra_bytes);
+ }
+ goto pop_next;
+ }
+ case BIN_MATCHSTATE_SUBTAG:
+ erl_exit(ERTS_ABORT_EXIT,
+ "size_shared: matchstate term not allowed");
+ default:
+ VERBOSE_DEBUG("/D");
+ sum += thing_arityval(hdr) + 1;
+ goto pop_next;
+ }
+ break;
+ }
+ case TAG_PRIMARY_IMMED1:
+ VERBOSE_DEBUG("I");
+ pop_next:
+ if (EQUEUE_ISEMPTY(s)) {
+ goto cleanup;
+ }
+ obj = EQUEUE_GET(s);
+ break;
+ default:
+ erl_exit(ERTS_ABORT_EXIT, "size_shared: bad tag for %#x\n", obj);
+ }
+ VERBOSE_DEBUG("\n");
+ }
+
+cleanup:
+ VERBOSE_DEBUG("\n");
+ obj = saved_obj;
+ BITSTORE_CLOSE(b);
+ for (;;) {
+ VERBOSE_DEBUG("[size] revisiting: %x ", obj);
+ switch (primary_tag(obj)) {
+ case TAG_PRIMARY_LIST: {
+ Eterm head, tail;
+ VERBOSE_DEBUG("L");
+ ptr = list_val_rel(obj, base);
+ if (!COUNT_OFF_HEAP && !INHEAP_SIMPLE(myself, ptr)) {
+ goto cleanup_next;
+ }
+ head = CAR(ptr);
+ tail = CDR(ptr);
+ /* if not already clean, clean it up */
+ if (primary_tag(tail) == TAG_PRIMARY_HEADER) {
+ if (primary_tag(head) == TAG_PRIMARY_HEADER) {
+ Eterm saved = BITSTORE_GET(b);
+ VERBOSE_DEBUG("/B restoring %d", saved);
+ CAR(ptr) = head = (head - TAG_PRIMARY_HEADER) | saved;
+ CDR(ptr) = tail = (tail - TAG_PRIMARY_HEADER) | TAG_PRIMARY_BOXED;
+ } else {
+ VERBOSE_DEBUG("/L");
+ CDR(ptr) = tail = (tail - TAG_PRIMARY_HEADER) | TAG_PRIMARY_LIST;
+ }
+ } else if (primary_tag(head) == TAG_PRIMARY_HEADER) {
+ VERBOSE_DEBUG("/I");
+ CAR(ptr) = head = (head - TAG_PRIMARY_HEADER) | primary_tag(tail);
+ CDR(ptr) = tail = (tail - primary_tag(tail)) | TAG_PRIMARY_IMMED1;
+ } else {
+ VERBOSE_DEBUG("!");
+ goto cleanup_next;
+ }
+ /* and its children too */
+ if (!IS_CONST(head)) {
+ EQUEUE_PUT_UNCHECKED(s, head);
+ }
+ obj = tail;
+ break;
+ }
+ case TAG_PRIMARY_BOXED: {
+ Eterm hdr;
+ VERBOSE_DEBUG("B");
+ ptr = boxed_val_rel(obj, base);
+ if (!COUNT_OFF_HEAP && !INHEAP_SIMPLE(myself, ptr)) {
+ goto cleanup_next;
+ }
+ hdr = *ptr;
+ /* if not already clean, clean it up */
+ if (primary_tag(hdr) == TAG_PRIMARY_HEADER) {
+ goto cleanup_next;
+ }
+ else {
+ ASSERT(primary_tag(hdr) == BOXED_VISITED);
+ *ptr = hdr = (hdr - BOXED_VISITED) + TAG_PRIMARY_HEADER;
+ }
+ /* and its children too */
+ switch (hdr & _TAG_HEADER_MASK) {
+ case ARITYVAL_SUBTAG: {
+ int arity = header_arity(hdr);
+ if (arity == 0) { /* Empty tuple -- unusual. */
+ goto cleanup_next;
+ }
+ while (arity-- > 0) {
+ obj = *++ptr;
+ if (!IS_CONST(obj)) {
+ EQUEUE_PUT_UNCHECKED(s, obj);
+ }
+ }
+ goto cleanup_next;
+ }
+ case FUN_SUBTAG: {
+ ErlFunThing* funp = (ErlFunThing *) ptr;
+ unsigned eterms = 1 /* creator */ + funp->num_free;
+ unsigned sz = thing_arityval(hdr);
+ ptr += 1 /* header */ + sz;
+ while (eterms-- > 0) {
+ obj = *ptr++;
+ if (!IS_CONST(obj)) {
+ EQUEUE_PUT_UNCHECKED(s, obj);
+ }
+ }
+ goto cleanup_next;
+ }
+ default:
+ goto cleanup_next;
+ }
+ break;
+ }
+ case TAG_PRIMARY_IMMED1:
+ cleanup_next:
+ if (EQUEUE_ISEMPTY(s)) {
+ goto all_clean;
+ }
+ obj = EQUEUE_GET(s);
+ break;
+ default:
+ erl_exit(ERTS_ABORT_EXIT, "size_shared: bad tag for %#x\n", obj);
+ }
+ VERBOSE_DEBUG("\n");
+ }
+
+ all_clean:
+ VERBOSE_DEBUG("\n");
+ /* Return the result */
+ DESTROY_EQUEUE(s);
+ DESTROY_BITSTORE(b);
+ return sum;
+}
+
+
+/*
* Copy a structure to a heap.
*/
Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
@@ -244,10 +598,18 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
Eterm org_obj = obj;
Uint org_sz = sz;
#endif
+#ifdef SHCOPY_DEBUG
+ Eterm mypid;
+#endif
if (IS_CONST(obj))
return obj;
+#ifdef SHCOPY_DEBUG
+ mypid = erts_get_current_pid();
+ VERBOSE_DEBUG("[pid=%T] copy_struct %p\n", mypid, obj);
+#endif
+
DTRACE1(copy_struct, (int32_t)sz);
hp = htop = *hpp;
@@ -529,9 +891,778 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
}
#endif
*hpp = (Eterm *) (hstart+hsize);
+ VERBOSE_DEBUG("[pid=%T] result is at %p\n", mypid, res);
return res;
}
+
+/*
+ * Machinery for the table used by the sharing preserving copier
+ * Using an ESTACK but not very transparently; consider refactoring
+ */
+
+#define DECLARE_SHTABLE(s) \
+ DECLARE_ESTACK(s); \
+ Uint ESTK_CONCAT(s,_offset) = 0
+#define DESTROY_SHTABLE(s) DESTROY_ESTACK(s)
+#define SHTABLE_INCR 4
+#define SHTABLE_NEXT(s) ESTK_CONCAT(s,_offset)
+#define SHTABLE_PUSH(s,x,y,b) \
+do { \
+ if (s.sp > s.end - SHTABLE_INCR) { \
+ erl_grow_estack(&s, ESTK_DEF_STACK(s)); \
+ } \
+ *s.sp++ = (x); \
+ *s.sp++ = (y); \
+ *s.sp++ = (Eterm) NULL; \
+ *s.sp++ = (Eterm) (b); /* bad in HALF_WORD */ \
+ ESTK_CONCAT(s,_offset) += SHTABLE_INCR; \
+} while(0)
+#define SHTABLE_X(s,e) (s.start[e])
+#define SHTABLE_Y(s,e) (s.start[(e)+1])
+#define SHTABLE_FWD(s,e) ((Eterm *) (s.start[(e)+2]))
+#define SHTABLE_FWD_UPD(s,e,p) (s.start[(e)+2] = (Eterm) (p))
+#define SHTABLE_REV(s,e) ((Eterm *) (s.start[(e)+3]))
+
+#define LIST_SHARED_UNPROCESSED ((Eterm) 0)
+#define LIST_SHARED_PROCESSED ((Eterm) 1)
+
+#define HEAP_ELEM_TO_BE_FILLED _unchecked_make_list(NULL)
+
+
+/*
+ * Specialized macros for using/reusing the persistent state
+ */
+
+#define DECLARE_EQUEUE_INIT_INFO(q, info) \
+ UWord* EQUE_DEF_QUEUE(q) = info->queue_default; \
+ ErtsEQueue q = { \
+ EQUE_DEF_QUEUE(q), /* start */ \
+ EQUE_DEF_QUEUE(q), /* front */ \
+ EQUE_DEF_QUEUE(q), /* back */ \
+ 1, /* possibly_empty */ \
+ EQUE_DEF_QUEUE(q) + DEF_EQUEUE_SIZE, /* end */ \
+ ERTS_ALC_T_ESTACK /* alloc_type */ \
+ }
+
+#define DECLARE_EQUEUE_FROM_INFO(q, info) \
+ /* no EQUE_DEF_QUEUE(q), read-only */ \
+ ErtsEQueue q = { \
+ info->queue_start, /* start */ \
+ info->queue_start, /* front */ \
+ info->queue_start, /* back */ \
+ 1, /* possibly_empty */ \
+ info->queue_end, /* end */ \
+ info->queue_alloc_type /* alloc_type */ \
+ }
+
+#define DECLARE_BITSTORE_INIT_INFO(s, info) \
+ UWord* WSTK_DEF_STACK(s) = info->bitstore_default; \
+ ErtsWStack s = { \
+ WSTK_DEF_STACK(s), /* wstart */ \
+ WSTK_DEF_STACK(s), /* wsp */ \
+ WSTK_DEF_STACK(s) + DEF_WSTACK_SIZE, /* wend */ \
+ ERTS_ALC_T_ESTACK /* alloc_type */ \
+ }; \
+ int WSTK_CONCAT(s,_bitoffs) = 0; \
+ /* no WSTK_CONCAT(s,_offset), write-only */ \
+ UWord WSTK_CONCAT(s,_buffer) = 0
+
+#define DECLARE_BITSTORE_FROM_INFO(s, info) \
+ /* no WSTK_DEF_STACK(s), read-only */ \
+ ErtsWStack s = { \
+ info->bitstore_start, /* wstart */ \
+ NULL, /* wsp, read-only */ \
+ NULL, /* wend, read-only */ \
+ info->bitstore_alloc_type /* alloc_type */ \
+ }; \
+ int WSTK_CONCAT(s,_bitoffs) = 0; \
+ int WSTK_CONCAT(s,_offset) = 0; \
+ UWord WSTK_CONCAT(s,_buffer) = 0
+
+#define DECLARE_SHTABLE_INIT_INFO(s, info) \
+ Eterm* ESTK_DEF_STACK(s) = info->shtable_default; \
+ ErtsEStack s = { \
+ ESTK_DEF_STACK(s), /* start */ \
+ ESTK_DEF_STACK(s), /* sp */ \
+ ESTK_DEF_STACK(s) + DEF_ESTACK_SIZE, /* end */ \
+ ERTS_ALC_T_ESTACK /* alloc_type */ \
+ }; \
+ Uint ESTK_CONCAT(s,_offset) = 0
+
+#define DECLARE_SHTABLE_FROM_INFO(s, info) \
+ /* no ESTK_DEF_STACK(s), read-only */ \
+ ErtsEStack s = { \
+ info->shtable_start, /* start */ \
+ NULL, /* sp, read-only */ \
+ NULL, /* end, read-only */ \
+ info->shtable_alloc_type /* alloc_type */ \
+ }; \
+ /* no ESTK_CONCAT(s,_offset), read-only */
+
+/*
+ * Copy object "obj" preserving sharing.
+ * First half: count size and calculate sharing.
+ * NOTE: We do not support HALF_WORD (yet?).
+ */
+Uint copy_shared_calculate(Eterm obj, shcopy_info *info, unsigned flags)
+{
+ Uint sum;
+ Uint e;
+ unsigned sz;
+ Eterm* ptr;
+ Process* myself;
+ int force_local = flags & ERTS_SHCOPY_FLG_TMP_BUF;
+
+ DECLARE_EQUEUE_INIT_INFO(s, info);
+ DECLARE_BITSTORE_INIT_INFO(b, info);
+ DECLARE_SHTABLE_INIT_INFO(t, info);
+
+ /* step #0:
+ -------------------------------------------------------
+ get rid of the easy cases first:
+ - copying constants
+ - if not a proper process, do flat copy
+ */
+
+ if (IS_CONST(obj))
+ return 0;
+
+ myself = erts_get_current_process();
+ if (myself == NULL || (flags & ERTS_SHCOPY_FLG_NONE))
+ return size_object(obj);
+
+ VERBOSE_DEBUG("[pid=%T] copy_shared_calculate %p\n", myself->common.id, obj);
+ VERBOSE_DEBUG("[pid=%T] message is %T\n", myself->common.id, obj);
+
+ /* step #1:
+ -------------------------------------------------------
+ traverse the term and calculate the size;
+ when traversing, transform as you do in size_shared
+ but when you find shared objects:
+
+ a. add entry in the table, indexed by i
+ b. mark them:
+ b1. boxed terms, set header to (i | 11)
+ store (old header, NONV, NULL, backptr) in the entry
+ b2. cons cells, set CDR to NONV, set CAR to i
+ store (old CAR, old CDR, NULL, backptr) in the entry
+ */
+
+ sum = 0;
+
+ for (;;) {
+ VERBOSE_DEBUG("[copy] visiting: %x ", obj);
+ switch (primary_tag(obj)) {
+ case TAG_PRIMARY_LIST: {
+ Eterm head, tail;
+ VERBOSE_DEBUG("L");
+ ptr = list_val_rel(obj, base);
+ /* off heap list pointers are copied verbatim */
+ if (!INHEAP(myself, ptr)) {
+ VERBOSE_DEBUG("[pid=%T] bypassed copying %p is %T\n", myself->common.id, ptr, obj);
+ if (myself->mbuf != NULL)
+ VERBOSE_DEBUG("[pid=%T] BUT !!! there are message buffers!\n", myself->common.id);
+ VERBOSE_DEBUG("#");
+ goto pop_next;
+ }
+ head = CAR(ptr);
+ tail = CDR(ptr);
+ /* if it's visited, don't count it;
+ if not already shared, make it shared and store it in the table */
+ if (primary_tag(tail) == TAG_PRIMARY_HEADER ||
+ primary_tag(head) == TAG_PRIMARY_HEADER) {
+ VERBOSE_DEBUG("!");
+ if (tail != THE_NON_VALUE) {
+ e = SHTABLE_NEXT(t);
+ VERBOSE_DEBUG("[pid=%T] tabling L %p\n", myself->common.id, ptr);
+ SHTABLE_PUSH(t, head, tail, ptr);
+ CAR(ptr) = (e << _TAG_PRIMARY_SIZE) | LIST_SHARED_UNPROCESSED;
+ CDR(ptr) = THE_NON_VALUE;
+ }
+ goto pop_next;
+ }
+ /* else make it visited now */
+ switch (primary_tag(tail)) {
+ case TAG_PRIMARY_LIST:
+ VERBOSE_DEBUG("/L");
+ VERBOSE_DEBUG("[pid=%T] mangling L/L %p\n", myself->common.id, ptr);
+ CDR(ptr) = (tail - TAG_PRIMARY_LIST) | TAG_PRIMARY_HEADER;
+ break;
+ case TAG_PRIMARY_IMMED1:
+ VERBOSE_DEBUG("/I");
+ VERBOSE_DEBUG("[pid=%T] mangling L/I %p\n", myself->common.id, ptr);
+ CAR(ptr) = (head - primary_tag(head)) | TAG_PRIMARY_HEADER;
+ CDR(ptr) = (tail - TAG_PRIMARY_IMMED1) | primary_tag(head);
+ break;
+ case TAG_PRIMARY_BOXED:
+ VERBOSE_DEBUG("/B saved %d", primary_tag(head));
+ BITSTORE_PUT(b, primary_tag(head));
+ VERBOSE_DEBUG("[pid=%T] mangling L/B %p\n", myself->common.id, ptr);
+ CAR(ptr) = (head - primary_tag(head)) | TAG_PRIMARY_HEADER;
+ CDR(ptr) = (tail - TAG_PRIMARY_BOXED) | TAG_PRIMARY_HEADER;
+ break;
+ }
+ /* and count it */
+ sum += 2;
+ if (!IS_CONST(head)) {
+ EQUEUE_PUT(s, head);
+ }
+ obj = tail;
+ break;
+ }
+ case TAG_PRIMARY_BOXED: {
+ Eterm hdr;
+ VERBOSE_DEBUG("B");
+ ptr = boxed_val_rel(obj, base);
+ /* off heap pointers to boxes are copied verbatim */
+ if (!INHEAP(myself, ptr)) {
+ VERBOSE_DEBUG("[pid=%T] bypassed copying %p is %T\n", myself->common.id, ptr, obj);
+ VERBOSE_DEBUG("#");
+ goto pop_next;
+ }
+ hdr = *ptr;
+ /* if it's visited, don't count it;
+ if not already shared, make it shared and store it in the table */
+ if (primary_tag(hdr) != TAG_PRIMARY_HEADER) {
+ VERBOSE_DEBUG("!");
+ if (primary_tag(hdr) == BOXED_VISITED) {
+ e = SHTABLE_NEXT(t);
+ VERBOSE_DEBUG("[pid=%T] tabling B %p\n", myself->common.id, ptr);
+ SHTABLE_PUSH(t, hdr, THE_NON_VALUE, ptr);
+ *ptr = (e << _TAG_PRIMARY_SIZE) | BOXED_SHARED_UNPROCESSED;
+ }
+ goto pop_next;
+ }
+ /* else make it visited now */
+ VERBOSE_DEBUG("[pid=%T] mangling B %p\n", myself->common.id, ptr);
+ *ptr = (hdr - primary_tag(hdr)) + BOXED_VISITED;
+ /* and count it */
+ ASSERT(is_header(hdr));
+ switch (hdr & _TAG_HEADER_MASK) {
+ case ARITYVAL_SUBTAG: {
+ int arity = header_arity(hdr);
+ VERBOSE_DEBUG("/T");
+ sum += arity + 1;
+ if (arity == 0) { /* Empty tuple -- unusual. */
+ VERBOSE_DEBUG("e");
+ goto pop_next;
+ }
+ while (arity-- > 0) {
+ obj = *++ptr;
+ if (!IS_CONST(obj)) {
+ EQUEUE_PUT(s, obj);
+ }
+ }
+ goto pop_next;
+ }
+ case FUN_SUBTAG: {
+ ErlFunThing* funp = (ErlFunThing *) ptr;
+ unsigned eterms = 1 /* creator */ + funp->num_free;
+ sz = thing_arityval(hdr);
+ VERBOSE_DEBUG("/F");
+ sum += 1 /* header */ + sz + eterms;
+ ptr += 1 /* header */ + sz;
+ while (eterms-- > 0) {
+ obj = *ptr++;
+ if (!IS_CONST(obj)) {
+ EQUEUE_PUT(s, obj);
+ }
+ }
+ goto pop_next;
+ }
+ case SUB_BINARY_SUBTAG: {
+ ErlSubBin* sb = (ErlSubBin *) ptr;
+ Eterm real_bin = sb->orig;
+ Uint bit_offset = sb->bitoffs;
+ Uint bit_size = sb->bitsize;
+ size_t size = sb->size;
+ Uint extra_bytes;
+ Eterm hdr;
+ if (bit_size + bit_offset > 8) {
+ sum += ERL_SUB_BIN_SIZE;
+ extra_bytes = 2;
+ } else if (bit_size + bit_offset > 0) {
+ sum += ERL_SUB_BIN_SIZE;
+ extra_bytes = 1;
+ } else {
+ extra_bytes = 0;
+ }
+ ASSERT(is_boxed(rterm2wterm(real_bin, base)) &&
+ (((*boxed_val(rterm2wterm(real_bin, base))) &
+ (_TAG_HEADER_MASK - _BINARY_XXX_MASK - BOXED_VISITED_MASK))
+ == _TAG_HEADER_REFC_BIN));
+ hdr = *_unchecked_binary_val(rterm2wterm(real_bin, base)) & ~BOXED_VISITED_MASK;
+ if (thing_subtag(hdr) == HEAP_BINARY_SUBTAG) {
+ sum += heap_bin_size(size+extra_bytes);
+ } else {
+ ASSERT(thing_subtag(hdr) == REFC_BINARY_SUBTAG);
+ sum += PROC_BIN_SIZE;
+ }
+ goto pop_next;
+ }
+ case BIN_MATCHSTATE_SUBTAG:
+ erl_exit(ERTS_ABORT_EXIT,
+ "size_shared: matchstate term not allowed");
+ default:
+ VERBOSE_DEBUG("/D");
+ sum += thing_arityval(hdr) + 1;
+ goto pop_next;
+ }
+ break;
+ }
+ case TAG_PRIMARY_IMMED1:
+ VERBOSE_DEBUG("I");
+ pop_next:
+ if (EQUEUE_ISEMPTY(s)) {
+ VERBOSE_DEBUG("\n");
+ // add sentinel to the table
+ SHTABLE_PUSH(t, THE_NON_VALUE, THE_NON_VALUE, NULL);
+ // store persistent info
+ BITSTORE_CLOSE(b);
+ info->queue_start = s.start;
+ info->queue_end = s.end;
+ info->queue_alloc_type = s.alloc_type;
+ info->bitstore_start = b.wstart;
+ info->bitstore_alloc_type = b.alloc_type;
+ info->shtable_start = t.start;
+ info->shtable_alloc_type = t.alloc_type;
+ // single point of return: the size of the object
+ VERBOSE_DEBUG("[pid=%T] size was: %u\n", myself->common.id, sum);
+ return sum;
+ }
+ obj = EQUEUE_GET(s);
+ break;
+ default:
+ erl_exit(ERTS_ABORT_EXIT, "[pid=%T] size_shared: bad tag for %#x\n", obj);
+ }
+ VERBOSE_DEBUG("\n");
+ }
+}
+
+
+/*
+ * Copy object "obj" preserving sharing.
+ * Second half: copy and restore the object.
+ * NOTE: We do not support HALF_WORD (yet?).
+ */
+Uint copy_shared_perform(Eterm obj, Uint size, shcopy_info *info, Eterm** hpp, ErlOffHeap* off_heap, unsigned flags)
+{
+ Uint e;
+ unsigned sz;
+ Eterm* ptr;
+ Eterm* hp;
+ Eterm* hscan;
+ Eterm result;
+ Eterm* resp;
+ unsigned remaining;
+ Process* myself;
+ int force_local = flags & ERTS_SHCOPY_FLG_TMP_BUF;
+#if defined(DEBUG) || defined(SHCOPY_DEBUG)
+ Eterm saved_obj = obj;
+#endif
+
+ DECLARE_EQUEUE_FROM_INFO(s, info);
+ DECLARE_BITSTORE_FROM_INFO(b, info);
+ DECLARE_SHTABLE_FROM_INFO(t, info);
+
+ /* step #0:
+ -------------------------------------------------------
+ get rid of the easy cases first:
+ - copying constants
+ - if not a proper process, do flat copy
+ */
+
+ if (IS_CONST(obj))
+ return obj;
+
+ myself = erts_get_current_process();
+ if (myself == NULL || (flags & ERTS_SHCOPY_FLG_NONE))
+ return copy_struct(obj, size, hpp, off_heap);
+
+ VERBOSE_DEBUG("[pid=%T] copy_shared_perform %p\n", myself->common.id, obj);
+
+ /* step #2: was performed before this function was called
+ -------------------------------------------------------
+ allocate new space
+ */
+
+ hscan = hp = *hpp;
+
+ /* step #3:
+ -------------------------------------------------------
+ traverse the term a second time and when traversing:
+ a. if the object is marked as shared
+ a1. if the entry contains a forwarding ptr, use that
+ a2. otherwise, copy it to the new space and store the
+ forwarding ptr to the entry
+ b. otherwise, reverse-transform as you do in size_shared
+ and copy to the new space
+ */
+
+ resp = &result;
+ remaining = 0;
+ for (;;) {
+ VERBOSE_DEBUG("[copy] revisiting: %x ", obj);
+ switch (primary_tag(obj)) {
+ case TAG_PRIMARY_LIST: {
+ Eterm head, tail;
+ VERBOSE_DEBUG("L");
+ ptr = list_val_rel(obj, base);
+ /* off heap list pointers are copied verbatim */
+ if (!INHEAP(myself, ptr)) {
+ VERBOSE_DEBUG("#");
+ *resp = obj;
+ goto cleanup_next;
+ }
+ head = CAR(ptr);
+ tail = CDR(ptr);
+ /* if it is shared */
+ if (tail == THE_NON_VALUE) {
+ e = head >> _TAG_PRIMARY_SIZE;
+ /* if it has been processed, just use the forwarding pointer */
+ if (primary_tag(head) == LIST_SHARED_PROCESSED) {
+ VERBOSE_DEBUG("!");
+ *resp = make_list(SHTABLE_FWD(t, e));
+ goto cleanup_next;
+ }
+ /* else, let's process it now,
+ copy it and keep the forwarding pointer */
+ else {
+ VERBOSE_DEBUG("$");
+ CAR(ptr) = (head - primary_tag(head)) + LIST_SHARED_PROCESSED;
+ head = SHTABLE_X(t, e);
+ tail = SHTABLE_Y(t, e);
+ ptr = &(SHTABLE_X(t, e));
+ VERBOSE_DEBUG("[pid=%T] tabled L %p is %p\n", myself->common.id, ptr, SHTABLE_REV(t, e));
+ SHTABLE_FWD_UPD(t, e, hp);
+ }
+ }
+ /* if not already clean, clean it up and copy it */
+ if (primary_tag(tail) == TAG_PRIMARY_HEADER) {
+ if (primary_tag(head) == TAG_PRIMARY_HEADER) {
+ Eterm saved = BITSTORE_GET(b);
+ VERBOSE_DEBUG("/B restoring %d", saved);
+ VERBOSE_DEBUG("[pid=%T] unmangling L/B %p\n", myself->common.id, ptr);
+ CAR(ptr) = head = (head - TAG_PRIMARY_HEADER) + saved;
+ CDR(ptr) = tail = (tail - TAG_PRIMARY_HEADER) + TAG_PRIMARY_BOXED;
+ } else {
+ VERBOSE_DEBUG("/L");
+ VERBOSE_DEBUG("[pid=%T] unmangling L/L %p\n", myself->common.id, ptr);
+ CDR(ptr) = tail = (tail - TAG_PRIMARY_HEADER) + TAG_PRIMARY_LIST;
+ }
+ } else if (primary_tag(head) == TAG_PRIMARY_HEADER) {
+ VERBOSE_DEBUG("/I");
+ VERBOSE_DEBUG("[pid=%T] unmangling L/I %p\n", myself->common.id, ptr);
+ CAR(ptr) = head = (head - TAG_PRIMARY_HEADER) | primary_tag(tail);
+ CDR(ptr) = tail = (tail - primary_tag(tail)) | TAG_PRIMARY_IMMED1;
+ } else {
+ ASSERT(0 && "cannot come here");
+ goto cleanup_next;
+ }
+ /* and its children too */
+ if (IS_CONST(head)) {
+ CAR(hp) = head;
+ } else {
+ EQUEUE_PUT_UNCHECKED(s, head);
+ CAR(hp) = HEAP_ELEM_TO_BE_FILLED;
+ }
+ *resp = make_list(hp);
+ resp = &(CDR(hp));
+ hp += 2;
+ obj = tail;
+ break;
+ }
+ case TAG_PRIMARY_BOXED: {
+ Eterm hdr;
+ VERBOSE_DEBUG("B");
+ ptr = boxed_val_rel(obj, base);
+ /* off heap pointers to boxes are copied verbatim */
+ if (!INHEAP(myself, ptr)) {
+ VERBOSE_DEBUG("#");
+ *resp = obj;
+ goto cleanup_next;
+ }
+ hdr = *ptr;
+ /* clean it up, unless it's already clean or shared and processed */
+ switch (primary_tag(hdr)) {
+ case TAG_PRIMARY_HEADER:
+ ASSERT(0 && "cannot come here");
+ /* if it is shared and has been processed,
+ just use the forwarding pointer */
+ case BOXED_SHARED_PROCESSED:
+ VERBOSE_DEBUG("!");
+ e = hdr >> _TAG_PRIMARY_SIZE;
+ *resp = make_boxed(SHTABLE_FWD(t, e));
+ goto cleanup_next;
+ /* if it is shared but has not been processed yet, let's process
+ it now: copy it and keep the forwarding pointer */
+ case BOXED_SHARED_UNPROCESSED:
+ e = hdr >> _TAG_PRIMARY_SIZE;
+ VERBOSE_DEBUG("$");
+ *ptr = (hdr - primary_tag(hdr)) + BOXED_SHARED_PROCESSED;
+ hdr = SHTABLE_X(t, e);
+ ASSERT(primary_tag(hdr) == BOXED_VISITED);
+ VERBOSE_DEBUG("[pid=%T] tabled B %p is %p\n", myself->common.id, ptr, SHTABLE_REV(t, e));
+ VERBOSE_DEBUG("[pid=%T] unmangling B %p\n", myself->common.id, ptr);
+ SHTABLE_X(t, e) = hdr = (hdr - BOXED_VISITED) + TAG_PRIMARY_HEADER;
+ SHTABLE_FWD_UPD(t, e, hp);
+ break;
+ case BOXED_VISITED:
+ VERBOSE_DEBUG("[pid=%T] unmangling B %p\n", myself->common.id, ptr);
+ *ptr = hdr = (hdr - BOXED_VISITED) + TAG_PRIMARY_HEADER;
+ break;
+ }
+ /* and its children too */
+ switch (hdr & _TAG_HEADER_MASK) {
+ case ARITYVAL_SUBTAG: {
+ int arity = header_arity(hdr);
+ *resp = make_boxed(hp);
+ *hp++ = hdr;
+ while (arity-- > 0) {
+ obj = *++ptr;
+ if (IS_CONST(obj)) {
+ *hp++ = obj;
+ } else {
+ EQUEUE_PUT_UNCHECKED(s, obj);
+ *hp++ = HEAP_ELEM_TO_BE_FILLED;
+ }
+ }
+ goto cleanup_next;
+ }
+ case FUN_SUBTAG: {
+ ErlFunThing* funp = (ErlFunThing *) ptr;
+ unsigned eterms = 1 /* creator */ + funp->num_free;
+ sz = thing_arityval(hdr);
+ funp = (ErlFunThing *) hp;
+ *resp = make_fun(hp);
+ *hp++ = hdr;
+ ptr++;
+ while (sz-- > 0) {
+ *hp++ = *ptr++;
+ }
+ while (eterms-- > 0) {
+ obj = *ptr++;
+ if (IS_CONST(obj)) {
+ *hp++ = obj;
+ } else {
+ EQUEUE_PUT_UNCHECKED(s, obj);
+ *hp++ = HEAP_ELEM_TO_BE_FILLED;
+ }
+ }
+ funp->next = off_heap->first;
+ off_heap->first = (struct erl_off_heap_header*) funp;
+ erts_refc_inc(&funp->fe->refc, 2);
+ goto cleanup_next;
+ }
+ case REFC_BINARY_SUBTAG: {
+ ProcBin* pb = (ProcBin *) ptr;
+ sz = thing_arityval(hdr);
+ if (pb->flags) {
+ erts_emasculate_writable_binary(pb);
+ }
+ pb = (ProcBin *) hp;
+ *resp = make_binary(hp);
+ *hp++ = hdr;
+ ptr++;
+ while (sz-- > 0) {
+ *hp++ = *ptr++;
+ }
+ erts_refc_inc(&pb->val->refc, 2);
+ pb->next = off_heap->first;
+ pb->flags = 0;
+ off_heap->first = (struct erl_off_heap_header*) pb;
+ OH_OVERHEAD(off_heap, pb->size / sizeof(Eterm));
+ goto cleanup_next;
+ }
+ case SUB_BINARY_SUBTAG: {
+ ErlSubBin* sb = (ErlSubBin *) ptr;
+ Eterm real_bin = sb->orig;
+ Uint bit_offset = sb->bitoffs;
+ Uint bit_size = sb->bitsize;
+ Uint offset = sb->offs;
+ size_t size = sb->size;
+ Uint extra_bytes;
+ Uint real_size;
+ if ((bit_size + bit_offset) > 8) {
+ extra_bytes = 2;
+ } else if ((bit_size + bit_offset) > 0) {
+ extra_bytes = 1;
+ } else {
+ extra_bytes = 0;
+ }
+ real_size = size+extra_bytes;
+ ASSERT(is_boxed(rterm2wterm(real_bin, base)) &&
+ (((*boxed_val(rterm2wterm(real_bin, base))) &
+ (_TAG_HEADER_MASK - _BINARY_XXX_MASK - BOXED_VISITED_MASK))
+ == _TAG_HEADER_REFC_BIN));
+ ptr = _unchecked_binary_val(rterm2wterm(real_bin, base));
+ *resp = make_binary(hp);
+ if (extra_bytes != 0) {
+ ErlSubBin* res = (ErlSubBin *) hp;
+ hp += ERL_SUB_BIN_SIZE;
+ res->thing_word = HEADER_SUB_BIN;
+ res->size = size;
+ res->bitsize = bit_size;
+ res->bitoffs = bit_offset;
+ res->offs = 0;
+ res->is_writable = 0;
+ res->orig = make_binary(hp);
+ }
+ if (thing_subtag(*ptr & ~BOXED_VISITED_MASK) == HEAP_BINARY_SUBTAG) {
+ ErlHeapBin* from = (ErlHeapBin *) ptr;
+ ErlHeapBin* to = (ErlHeapBin *) hp;
+ hp += heap_bin_size(real_size);
+ to->thing_word = header_heap_bin(real_size);
+ to->size = real_size;
+ sys_memcpy(to->data, ((byte *)from->data)+offset, real_size);
+ } else {
+ ProcBin* from = (ProcBin *) ptr;
+ ProcBin* to = (ProcBin *) hp;
+ ASSERT(thing_subtag(*ptr & ~BOXED_VISITED_MASK) == REFC_BINARY_SUBTAG);
+ if (from->flags) {
+ erts_emasculate_writable_binary(from);
+ }
+ hp += PROC_BIN_SIZE;
+ to->thing_word = HEADER_PROC_BIN;
+ to->size = real_size;
+ to->val = from->val;
+ erts_refc_inc(&to->val->refc, 2);
+ to->bytes = from->bytes + offset;
+ to->next = off_heap->first;
+ to->flags = 0;
+ off_heap->first = (struct erl_off_heap_header*) to;
+ OH_OVERHEAD(off_heap, to->size / sizeof(Eterm));
+ }
+ goto cleanup_next;
+ }
+ case EXTERNAL_PID_SUBTAG:
+ case EXTERNAL_PORT_SUBTAG:
+ case EXTERNAL_REF_SUBTAG: {
+ ExternalThing *etp = (ExternalThing *) hp;
+ sz = thing_arityval(hdr);
+ *resp = make_external(hp);
+ *hp++ = hdr;
+ ptr++;
+ while (sz-- > 0) {
+ *hp++ = *ptr++;
+ }
+ etp->next = off_heap->first;
+ off_heap->first = (struct erl_off_heap_header*) etp;
+ erts_refc_inc(&etp->node->refc, 2);
+ goto cleanup_next;
+ }
+ default:
+ sz = thing_arityval(hdr);
+ *resp = make_boxed(hp);
+ *hp++ = hdr;
+ ptr++;
+ while (sz-- > 0) {
+ *hp++ = *ptr++;
+ }
+ goto cleanup_next;
+ }
+ break;
+ }
+ case TAG_PRIMARY_IMMED1:
+ *resp = obj;
+ cleanup_next:
+ if (EQUEUE_ISEMPTY(s)) {
+ goto all_clean;
+ }
+ obj = EQUEUE_GET(s);
+ for (;;) {
+ ASSERT(hscan < hp);
+ if (remaining == 0) {
+ if (*hscan == HEAP_ELEM_TO_BE_FILLED) {
+ resp = hscan;
+ hscan += 2;
+ break; /* scanning loop */
+ } else if (primary_tag(*hscan) == TAG_PRIMARY_HEADER) {
+ switch (*hscan & _TAG_HEADER_MASK) {
+ case ARITYVAL_SUBTAG:
+ remaining = header_arity(*hscan);
+ hscan++;
+ break;
+ case FUN_SUBTAG: {
+ ErlFunThing* funp = (ErlFunThing *) hscan;
+ hscan += 1 + thing_arityval(*hscan);
+ remaining = 1 + funp->num_free;
+ break;
+ }
+ case SUB_BINARY_SUBTAG:
+ ASSERT(((ErlSubBin *) hscan)->bitoffs +
+ ((ErlSubBin *) hscan)->bitsize > 0);
+ hscan += ERL_SUB_BIN_SIZE;
+ break;
+ default:
+ hscan += 1 + thing_arityval(*hscan);
+ break;
+ }
+ } else {
+ hscan++;
+ }
+ } else if (*hscan == HEAP_ELEM_TO_BE_FILLED) {
+ resp = hscan++;
+ remaining--;
+ break; /* scanning loop */
+ } else {
+ hscan++;
+ remaining--;
+ }
+ }
+ ASSERT(resp < hp);
+ break;
+ default:
+ erl_exit(ERTS_ABORT_EXIT, "size_shared: bad tag for %#x\n", obj);
+ }
+ VERBOSE_DEBUG("\n");
+ }
+
+ /* step #4:
+ -------------------------------------------------------
+ traverse the table and reverse-transform all stored entries
+ */
+
+all_clean:
+ VERBOSE_DEBUG("\n");
+ for (e = 0; ; e += SHTABLE_INCR) {
+ ptr = SHTABLE_REV(t, e);
+ if (ptr == NULL)
+ break;
+ VERBOSE_DEBUG("[copy] restoring shared: %x\n", ptr);
+ /* entry was a list */
+ if (SHTABLE_Y(t, e) != THE_NON_VALUE) {
+ VERBOSE_DEBUG("[pid=%T] untabling L %p\n", myself->common.id, ptr);
+ CAR(ptr) = SHTABLE_X(t, e);
+ CDR(ptr) = SHTABLE_Y(t, e);
+ }
+ /* entry was boxed */
+ else {
+ VERBOSE_DEBUG("[pid=%T] untabling B %p\n", myself->common.id, ptr);
+ *ptr = SHTABLE_X(t, e);
+ ASSERT(primary_tag(*ptr) == TAG_PRIMARY_HEADER);
+ }
+ }
+
+#ifdef DEBUG
+ if (eq(saved_obj, result) == 0) {
+ erts_fprintf(stderr, "original = %T\n", saved_obj);
+ erts_fprintf(stderr, "copy = %T\n", result);
+ erl_exit(ERTS_ABORT_EXIT, "copy (shared) not equal to source\n");
+ }
+#endif
+
+ VERBOSE_DEBUG("[pid=%T] original was %T\n", myself->common.id, saved_obj);
+ VERBOSE_DEBUG("[pid=%T] copy is %T\n", myself->common.id, result);
+ VERBOSE_DEBUG("[pid=%T] result is at %p\n", myself->common.id, result);
+
+ ASSERT(hp == *hpp + size);
+ *hpp = hp;
+ return result;
+}
+
+
/*
* Copy a term that is guaranteed to be contained in a single
* heap block. The heap block is copied word by word, and any
diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c
index 6cb37752bc..ec96a7563a 100644
--- a/erts/emulator/beam/erl_gc.c
+++ b/erts/emulator/beam/erl_gc.c
@@ -42,6 +42,8 @@
#include "dtrace-wrapper.h"
#include "erl_bif_unique.h"
+#undef SHCOPY_DEBUG
+
#define ERTS_INACT_WR_PB_LEAVE_MUCH_LIMIT 1
#define ERTS_INACT_WR_PB_LEAVE_MUCH_PERCENTAGE 20
#define ERTS_INACT_WR_PB_LEAVE_LIMIT 10
@@ -1166,6 +1168,10 @@ do_minor(Process *p, ErlHeapFragment *live_hf_end,
char* oh = (char *) OLD_HEAP(p);
Uint oh_size = (char *) OLD_HTOP(p) - oh;
+#ifdef SHCOPY_DEBUG
+ VERBOSE_DEBUG("[pid=%T] MINOR GC: %p %p %p %p\n", p->common.id, HEAP_START(p), HEAP_END(p), OLD_HEAP(p), OLD_HEND(p));
+#endif
+
n_htop = n_heap = (Eterm*) ERTS_HEAP_ALLOC(ERTS_ALC_T_HEAP,
sizeof(Eterm)*new_sz);
@@ -1383,6 +1389,10 @@ major_collection(Process* p, ErlHeapFragment *live_hf_end,
Uint new_sz, stk_sz;
int adjusted;
+#ifdef SHCOPY_DEBUG
+ VERBOSE_DEBUG("[pid=%T] MAJOR GC: %p %p %p %p\n", p->common.id, HEAP_START(p), HEAP_END(p), OLD_HEAP(p), OLD_HEND(p));
+#endif
+
/*
* Do a fullsweep GC. First figure out the size of the heap
* to receive all live data.
diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h
index 20f100b427..d99f6548f9 100644
--- a/erts/emulator/beam/global.h
+++ b/erts/emulator/beam/global.h
@@ -919,8 +919,9 @@ do { \
#define EQUEUE_ISEMPTY(q) (q.back == q.front && q.possibly_empty)
#define EQUEUE_GET(q) ({ \
+ UWord x; \
q.possibly_empty = 1; \
- UWord x = *(q.front); \
+ x = *(q.front); \
if (++(q.front) == q.end) { \
q.front = q.start; \
} \
@@ -1035,11 +1036,64 @@ __decl_noreturn void __noreturn erl_exit(int n, char*, ...);
__decl_noreturn void __noreturn erl_exit_flush_async(int n, char*, ...);
void erl_error(char*, va_list);
+/* This controls whether sharing-preserving copy is used by Erlang */
+
+#define SHCOPY_SEND
+#define SHCOPY_SPAWN
+
+#if defined(SHCOPY_SEND) \
+ || defined(SHCOPY_SPAWN)
+#define SHCOPY
+/* Use this with care, it is *very* verbose! */
+#undef SHCOPY_DEBUG
+#endif
+
+#define VERBOSE_DEBUG(...) do { \
+ erts_fprintf(stderr, __VA_ARGS__); \
+ } while(0)
+
+#define ERTS_SHCOPY_FLG_MASK (((unsigned) 3) << 0)
+#define ERTS_SHCOPY_FLG_NONE (((unsigned) 1) << 0)
+#define ERTS_SHCOPY_FLG_TMP_BUF (((unsigned) 1) << 1)
+
+/* The persistent state while the sharing-preserving copier works */
+
+typedef struct shcopy_info {
+ Eterm queue_default[DEF_EQUEUE_SIZE];
+ Eterm* queue_start;
+ Eterm* queue_end;
+ ErtsAlcType_t queue_alloc_type;
+ UWord bitstore_default[DEF_WSTACK_SIZE];
+ UWord* bitstore_start;
+ ErtsAlcType_t bitstore_alloc_type;
+ Eterm shtable_default[DEF_ESTACK_SIZE];
+ Eterm* shtable_start;
+ ErtsAlcType_t shtable_alloc_type;
+} shcopy_info;
+
+#define DESTROY_INFO(info) \
+do { \
+ if (info.queue_start != info.queue_default) { \
+ erts_free(info.queue_alloc_type, info.queue_start); \
+ } \
+ if (info.bitstore_start != info.bitstore_default) { \
+ erts_free(info.bitstore_alloc_type, info.bitstore_start); \
+ } \
+ if (info.shtable_start != info.shtable_default) { \
+ erts_free(info.shtable_alloc_type, info.shtable_start); \
+ } \
+} while(0)
+
/* copy.c */
Eterm copy_object_x(Eterm, Process*, Uint);
#define copy_object(Term, Proc) copy_object_x(Term,Proc,0)
Uint size_object(Eterm);
+Uint copy_shared_calculate(Eterm, shcopy_info*, unsigned);
+Eterm copy_shared_perform(Eterm, Uint, shcopy_info*, Eterm**, ErlOffHeap*, unsigned);
+
+Uint size_shared(Eterm);
+
Eterm copy_struct(Eterm, Uint, Eterm**, ErlOffHeap*);
Eterm copy_shallow(Eterm*, Uint, Eterm**, ErlOffHeap*);
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-13 03:44:22 +0000