Make tracing and distribution work

Rewrite trace code and external coding. Also slightly correct
the interface to the match-spec engine to make tracing work.

That will make the test suites runnable.

10 files changed, 101 insertions, 45 deletions

diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c
index 8113e78583..1078478ed9 100644
--- a/erts/emulator/beam/beam_emu.c
+++ b/erts/emulator/beam/beam_emu.c
@@ -2621,6 +2621,7 @@ void process_main(void)
 
      SWAPOUT;
      reg[0] = r(0);
+
      next = call_fun(c_p, Arg(0), reg, THE_NON_VALUE);
      SWAPIN;
      if (next != NULL) {
@@ -6049,8 +6050,12 @@ call_fun(Process* p,		/* Current process. */
 	    }
 	}
     } else if (is_export_header(hdr)) {
-	Export* ep = *((Export **) (export_val(fun) + 1));
-	int actual_arity = (int) ep->code[2];
+	Export *ep;
+	int actual_arity;
+
+	ep = *((Export **) (export_val(fun) + 1));
+	actual_arity = (int) ep->code[2];
+
 	if (arity == actual_arity) {
 	    return ep->address;
 	} else {
diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c
index c06d92ed45..85bf584337 100644
--- a/erts/emulator/beam/bif.c
+++ b/erts/emulator/beam/bif.c
@@ -3468,12 +3468,14 @@ BIF_RETTYPE make_fun_3(BIF_ALIST_3)
     if (arity < 0) {
 	goto error;
     }
-    hp = HAlloc(BIF_P, 2);
-    hp[0] = HEADER_EXPORT;
 #if HALFWORD_HEAP
+    hp = HAlloc(BIF_P, 3);
+    hp[0] = HEADER_EXPORT;
     /* Yes, May be misaligned, but X86_64 will fix it... */
-    memcpy(hp+1,erts_export_get_or_make_stub(BIF_ARG_1, BIF_ARG_2, (Uint) arity),sizeof(Export *));
+    *((Export **) (hp+1)) = erts_export_get_or_make_stub(BIF_ARG_1, BIF_ARG_2, (Uint) arity);
 #else
+    hp = HAlloc(BIF_P, 2);
+    hp[0] = HEADER_EXPORT;
     hp[1] = (Eterm) erts_export_get_or_make_stub(BIF_ARG_1, BIF_ARG_2, (Uint) arity);
 #endif
     BIF_RET(make_export(hp));
diff --git a/erts/emulator/beam/erl_db.c b/erts/emulator/beam/erl_db.c
index 88a9e56854..4c75659246 100644
--- a/erts/emulator/beam/erl_db.c
+++ b/erts/emulator/beam/erl_db.c
@@ -2597,7 +2597,7 @@ BIF_RETTYPE ets_match_spec_run_r_3(BIF_ALIST_3)
 	    BIF_TRAP3(bif_export[BIF_ets_match_spec_run_r_3],
 		      BIF_P,lst,BIF_ARG_2,ret);
 	}
-	res = db_prog_match(BIF_P, mp, CAR(list_val(lst)), 0, &dummy);
+	res = db_prog_match(BIF_P, mp, CAR(list_val(lst)), NULL, 0, &dummy);
 	if (is_value(res)) {
 	    sz = size_object(res);
 	    hp = HAlloc(BIF_P, sz + 2);
diff --git a/erts/emulator/beam/erl_db_hash.c b/erts/emulator/beam/erl_db_hash.c
index 4141f9766b..124129a371 100644
--- a/erts/emulator/beam/erl_db_hash.c
+++ b/erts/emulator/beam/erl_db_hash.c
@@ -1284,7 +1284,7 @@ static int db_select_continue_hash(Process *p,
 	    (match_res = 
 	     db_prog_match(p,mp,
 			   make_tuple(current->dbterm.tpl),
-			   0,&dummy),
+			   NULL,0,&dummy),
 	     is_value(match_res))) {
 	    if (all_objects) {
 		hp = HAlloc(p, current->dbterm.size + 2);
@@ -1462,7 +1462,7 @@ static int db_select_chunk_hash(Process *p, DbTable *tbl,
 	    if (current->hvalue != INVALID_HASH) {
 		match_res = db_prog_match(p,mpi.mp,
 					  make_tuple(current->dbterm.tpl),
-					  0,&dummy);
+					  NULL,0,&dummy);
 		if (is_value(match_res)) {
 		    if (mpi.all_objects) {
 			hp = HAlloc(p, current->dbterm.size + 2);
@@ -1641,7 +1641,7 @@ static int db_select_count_hash(Process *p,
 	if (current != NULL) {
 	    if (current->hvalue != INVALID_HASH) {
 		if (db_prog_match(p, mpi.mp, make_tuple(current->dbterm.tpl),
-				  0, &dummy) == am_true) {
+				  NULL,0, &dummy) == am_true) {
 		    ++got;
 		}
 		--num_left;
@@ -1792,7 +1792,7 @@ static int db_select_delete_hash(Process *p,
 	    int did_erase = 0;
 	    if ((db_prog_match(p,mpi.mp,
 			       make_tuple((*current)->dbterm.tpl),
-			       0,&dummy)) == am_true) {
+			       NULL,0,&dummy)) == am_true) {
 		if (NFIXED(tb) > fixated_by_me) { /* fixated by others? */
 		    if (slot_ix != last_pseudo_delete) {
 			add_fixed_deletion(tb, slot_ix);
@@ -1904,7 +1904,7 @@ static int db_select_delete_continue_hash(Process *p,
 	else {
 	    int did_erase = 0;
 	    if ((db_prog_match(p,mp,make_tuple((*current)->dbterm.tpl),
-			       0,&dummy)) == am_true) {
+			       NULL,0,&dummy)) == am_true) {
 		if (NFIXED(tb) > fixated_by_me) { /* fixated by others? */
 		    if (slot_ix != last_pseudo_delete) {
 			add_fixed_deletion(tb, slot_ix);
@@ -2005,7 +2005,7 @@ static int db_select_count_continue_hash(Process *p,
 		continue;
 	    }
 	    if (db_prog_match(p, mp, make_tuple(current->dbterm.tpl),
-			      0,&dummy) == am_true) {
+			      NULL,0,&dummy) == am_true) {
 		++got;
 	    }
 	    --num_left;
diff --git a/erts/emulator/beam/erl_db_tree.c b/erts/emulator/beam/erl_db_tree.c
index f9ed5fe292..b6b3cabafe 100644
--- a/erts/emulator/beam/erl_db_tree.c
+++ b/erts/emulator/beam/erl_db_tree.c
@@ -3023,7 +3023,7 @@ static int doit_select(DbTableTree *tb, TreeDbTerm *this, void *ptr,
     }
     ret = db_prog_match(sc->p, sc->mp,
 			make_tuple(this->dbterm.tpl), 
-			0, &dummy);
+			NULL,0, &dummy);
     if (is_value(ret)) {
 	Uint sz;
 	Eterm *hp;
@@ -3072,7 +3072,7 @@ static int doit_select_count(DbTableTree *tb, TreeDbTerm *this, void *ptr,
     }
     ret = db_prog_match(sc->p, sc->mp,
 			make_tuple(this->dbterm.tpl), 
-			0, &dummy);
+			NULL,0, &dummy);
     if (ret == am_true) {
 	++(sc->got);
     }
@@ -3105,7 +3105,7 @@ static int doit_select_chunk(DbTableTree *tb, TreeDbTerm *this, void *ptr,
 
     ret = db_prog_match(sc->p, sc->mp,
 			make_tuple(this->dbterm.tpl), 
-			0, &dummy);
+			NULL,0, &dummy);
     if (is_value(ret)) {
 	Uint sz;
 	Eterm *hp;
@@ -3158,7 +3158,7 @@ static int doit_select_delete(DbTableTree *tb, TreeDbTerm *this, void *ptr,
 	return 0;
     ret = db_prog_match(sc->p, sc->mp,
 			make_tuple(this->dbterm.tpl), 
-			0, &dummy);
+			NULL,0, &dummy);
     if (ret == am_true) {
 	key = GETKEY(sc->tb, this->dbterm.tpl);
 	linkout_tree(sc->tb, key);
diff --git a/erts/emulator/beam/erl_db_util.c b/erts/emulator/beam/erl_db_util.c
index f8baf44e10..165c56cbf1 100644
--- a/erts/emulator/beam/erl_db_util.c
+++ b/erts/emulator/beam/erl_db_util.c
@@ -1185,7 +1185,7 @@ Eterm erts_match_set_run(Process *p, Binary *mpsp,
     Eterm ret;
 
     ret = db_prog_match(p, mpsp,
-			(Eterm) COMPRESS_POINTER(args),
+			NIL, args,
 			num_args, return_flags);
 #if defined(HARDDEBUG)
     if (is_non_value(ret)) {
@@ -1380,7 +1380,7 @@ restart:
     
 	/* 
 	** There is one single top variable in the match expression
-	** iff the text is tho Uint's and the single instruction 
+	** iff the text is two Uint's and the single instruction
 	** is 'matchBind' or it is only a skip.
 	*/
 	context.special = 
@@ -1591,6 +1591,7 @@ static Eterm dpm_array_to_list(Process *psp, Eterm *arr, int arity)
 ** i.e. 'DCOMP_TRACE' was specified 
 */
 Eterm db_prog_match(Process *c_p, Binary *bprog, Eterm term, 
+		    Eterm *termp,
 		    int arity,
 		    Uint32 *return_flags)
 {
@@ -1710,12 +1711,12 @@ restart:
 	    n = *pc++;
 	    if ((int) n != arity)
 		FAIL();
-	    ep = (Eterm *) EXPAND_POINTER(*ep);
+	    ep = termp;
 	    break;
 	case matchArrayBind: /* When the array size is unknown. */ /* XXX:PaN - where does
 								      this array come from? */
 	    n = *pc++;
-	    hp[n] = dpm_array_to_list(psp, (Eterm *) EXPAND_POINTER(term), arity);
+	    hp[n] = dpm_array_to_list(psp, termp, arity);
 	    break;
 	case matchTuple: /* *ep is a tuple of arity n */
 	    if (!is_tuple(*ep))
@@ -2101,13 +2102,13 @@ restart:
  		*esp++ = am_undefined;
  	    } else {
  		*esp++ = make_tuple(ehp);
- 		ehp[0] = make_arityval(3);
+		ehp[0] = make_arityval(3);
 		ehp[1] = cp[0];
 		ehp[2] = cp[1];
-		ehp[3] = make_small((Uint) hp[2]);
- 		ehp += 4;
- 	    }
- 	    break;
+		ehp[3] = make_small((Uint) cp[2]);
+		ehp += 4;
+	    }
+	    break;
 	case matchSilent:
 	    --esp;
 	    if (*esp == am_true) {
@@ -4278,7 +4279,7 @@ static Eterm match_spec_test(Process *p, Eterm against, Eterm spec, int trace)
 	    }
 	} else {
 	    n = 0;
-	    arr = (Eterm *) EXPAND_POINTER(against);
+	    arr = tuple_val(against);
 	}
 	
 	/* We are in the context of a BIF, 
diff --git a/erts/emulator/beam/erl_db_util.h b/erts/emulator/beam/erl_db_util.h
index fbc25aaf2b..5959e62025 100644
--- a/erts/emulator/beam/erl_db_util.h
+++ b/erts/emulator/beam/erl_db_util.h
@@ -366,7 +366,7 @@ Binary *db_match_compile(Eterm *matchexpr, Eterm *guards,
 			 Uint flags, 
 			 DMCErrInfo *err_info);
 /* Returns newly allocated MatchProg binary with refc == 0*/
-Eterm db_prog_match(Process *p, Binary *prog, Eterm term, int arity, 
+Eterm db_prog_match(Process *p, Binary *prog, Eterm term, Eterm *termp, int arity,
 		    Uint32 *return_flags /* Zeroed on enter */);
 /* returns DB_ERROR_NONE if matches, 1 if not matches and some db error on 
    error. */
diff --git a/erts/emulator/beam/erl_term.h b/erts/emulator/beam/erl_term.h
index 25d12bf16e..3a8c30fe6a 100644
--- a/erts/emulator/beam/erl_term.h
+++ b/erts/emulator/beam/erl_term.h
@@ -849,6 +849,11 @@ _ET_DECLARE_CHECKED(struct erl_node_*,internal_ref_node,Eterm)
  *
  */
 
+/* XXX:PaN - this structure is not perfect for halfword heap, it takes
+   a lot of memory due to padding, and the array will not begin at the end of the
+   structure, as otherwise expected. Be sure to access data.ui32 array and not try
+   to do pointer manipulation on an Eterm * to reach the actual data... */
+
 typedef struct external_thing_ {
     /*                                 ----+                        */
     Eterm                   header;     /* |                        */
diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c
index 7f39f8eb12..ac8dd27b15 100644
--- a/erts/emulator/beam/external.c
+++ b/erts/emulator/beam/external.c
@@ -2260,18 +2260,25 @@ dec_term_atom_common:
 		node = erts_find_or_insert_node(sysname, cre);
 		if(node == erts_this_node) {
 		    RefThing *rtp = (RefThing *) hp;
-		    hp += REF_THING_HEAD_SIZE;
+		    ref_num = (Uint32 *) (hp + REF_THING_HEAD_SIZE);
+
 #if defined(ARCH_64) && !HALFWORD_HEAP
+		    hp += REF_THING_HEAD_SIZE + ref_words/2 + 1;
 		    rtp->header = make_ref_thing_header(ref_words/2 + 1);
 #else
+		    hp += REF_THING_HEAD_SIZE + ref_words;
 		    rtp->header = make_ref_thing_header(ref_words);
 #endif
 		    *objp = make_internal_ref(rtp);
 		}
 		else {
 		    ExternalThing *etp = (ExternalThing *) hp;
-		    hp += EXTERNAL_THING_HEAD_SIZE;
-		    
+#if defined(ARCH_64) && !HALFWORD_HEAP
+		    hp += EXTERNAL_THING_HEAD_SIZE + ref_words/2 + 1;
+#else
+		    hp += EXTERNAL_THING_HEAD_SIZE + ref_words;
+#endif
+
 #if defined(ARCH_64) && !HALFWORD_HEAP
 		    etp->header = make_external_ref_header(ref_words/2 + 1);
 #else
@@ -2282,9 +2289,9 @@ dec_term_atom_common:
 
 		    off_heap->externals = etp;
 		    *objp = make_external_ref(etp);
+		    ref_num = &(etp->data.ui32[0]);
 		}
 
-		ref_num = (Uint32 *) hp;
 #if defined(ARCH_64) && !HALFWORD_HEAP
 		*(ref_num++) = ref_words /* 32-bit arity */;
 #endif
@@ -2296,9 +2303,6 @@ dec_term_atom_common:
 #if defined(ARCH_64) && !HALFWORD_HEAP
 		if ((1 + ref_words) % 2)
 		    ref_num[ref_words] = 0;
-		hp += ref_words/2 + 1;
-#else
-		hp += ref_words;
 #endif
 		break;
 	    }
diff --git a/lib/runtime_tools/src/dbg.erl b/lib/runtime_tools/src/dbg.erl
index 66ac0422eb..7fed34afdc 100644
--- a/lib/runtime_tools/src/dbg.erl
+++ b/lib/runtime_tools/src/dbg.erl
@@ -945,7 +945,7 @@ dhandler(end_of_trace, Out) ->
 dhandler(Trace, Out) when element(1, Trace) == trace, tuple_size(Trace) >= 3 ->
     dhandler1(Trace, tuple_size(Trace), Out);
 dhandler(Trace, Out) when element(1, Trace) == trace_ts, tuple_size(Trace) >= 4 ->
-    dhandler1(Trace, tuple_size(Trace)-1, Out);
+    dhandler1(Trace, tuple_size(Trace)-1, element(tuple_size(Trace),Trace), Out);
 dhandler(Trace, Out) when element(1, Trace) == drop, tuple_size(Trace) =:= 2 ->
     io:format(Out, "*** Dropped ~p messages.~n", [element(2,Trace)]),
     Out;
@@ -978,24 +978,18 @@ dhandler(_Trace, Out) ->
     Out.
 
 dhandler1(Trace, Size, Out) ->
-%%%!    Self = self(),
     From = element(2, Trace),
     case element(3, Trace) of
 	'receive' ->
 	    case element(4, Trace) of
 		{dbg,ok} -> ok;
-		Message -> io:format(Out, "(~p) << ~p~n", [From,Message])
+		Message ->
+		    io:format(Out, "(~p) << ~p~n", [From,Message])
 	    end;
 	'send' ->
 	    Message = element(4, Trace),
-	    case element(5, Trace) of
-%%%! This causes messages to disappear when used by ttb (observer). Tests
-%%%! so far show that there is no difference in results with dbg even if I
-%%%! comment it out, so  I hope this is only some old code which isn't
-%%%! needed anymore... /siri
-%%%!		Self -> ok;
-		To -> io:format(Out, "(~p) ~p ! ~p~n", [From,To,Message])
-	    end;
+	    To = element(5, Trace),
+	    io:format(Out, "(~p) ~p ! ~p~n", [From,To,Message]);
 	call ->
 	    case element(4, Trace) of
 		MFA when Size == 5 ->
@@ -1028,6 +1022,51 @@ dhandler1(Trace, Size, Out) ->
     end,
     Out.
 
+dhandler1(Trace, Size, TS, Out) ->
+    From = element(2, Trace),
+    case element(3, Trace) of
+	'receive' ->
+	    case element(4, Trace) of
+		{dbg,ok} -> ok;
+		Message ->
+		    io:format(Out, "(~p) << ~p (Timestamp: ~p)~n", [From,Message,TS])
+	    end;
+	'send' ->
+	    Message = element(4, Trace),
+	    To = element(5, Trace),
+	    io:format(Out, "(~p) ~p ! ~p (Timestamp: ~p)~n", [From,To,Message,TS]);
+	call ->
+	    case element(4, Trace) of
+		MFA when Size == 5 ->
+		    Message = element(5, Trace),
+		    io:format(Out, "(~p) call ~s (~p) (Timestamp: ~p)~n", [From,ffunc(MFA),Message,TS]);
+		MFA ->
+		    io:format(Out, "(~p) call ~s (Timestamp: ~p)~n", [From,ffunc(MFA),TS])
+	    end;
+	return -> %% To be deleted...
+	    case element(4, Trace) of
+		MFA when Size == 5 ->
+		    Ret = element(5, Trace),
+		    io:format(Out, "(~p) old_ret ~s -> ~p (Timestamp: ~p)~n", [From,ffunc(MFA),Ret,TS]);
+		MFA ->
+		    io:format(Out, "(~p) old_ret ~s (Timestamp: ~p)~n", [From,ffunc(MFA),TS])
+	    end;
+	return_from ->
+	    MFA = element(4, Trace),
+	    Ret = element(5, Trace),
+	    io:format(Out, "(~p) returned from ~s -> ~p (Timestamp: ~p)~n", [From,ffunc(MFA),Ret,TS]);
+	return_to ->
+	    MFA = element(4, Trace),
+	    io:format(Out, "(~p) returning to ~s (Timestamp: ~p)~n", [From,ffunc(MFA),TS]);
+	spawn when Size == 5 ->
+	    Pid = element(4, Trace),
+	    MFA = element(5, Trace),
+	    io:format(Out, "(~p) spawn ~p as ~s (Timestamp: ~p)~n", [From,Pid,ffunc(MFA),TS]);
+	Op ->
+	    io:format(Out, "(~p) ~p ~s (Timestamp: ~p)~n", [From,Op,ftup(Trace,4,Size),TS])
+    end,
+    Out.
+
 
 
 %%% These f* functions returns non-flat strings