The R13B03 release.OTP_R13B03

1 files changed, 4651 insertions, 0 deletions

diff --git a/erts/emulator/beam/erl_db_util.c b/erts/emulator/beam/erl_db_util.c
new file mode 100644
index 0000000000..8c373451fd
--- /dev/null
+++ b/erts/emulator/beam/erl_db_util.c
@@ -0,0 +1,4651 @@
+/*
+ * %CopyrightBegin%
+ * 
+ * Copyright Ericsson AB 1998-2009. All Rights Reserved.
+ * 
+ * The contents of this file are subject to the Erlang Public License,
+ * Version 1.1, (the "License"); you may not use this file except in
+ * compliance with the License. You should have received a copy of the
+ * Erlang Public License along with this software. If not, it can be
+ * retrieved online at http://www.erlang.org/.
+ * 
+ * Software distributed under the License is distributed on an "AS IS"
+ * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ * the License for the specific language governing rights and limitations
+ * under the License.
+ * 
+ * %CopyrightEnd%
+ */
+
+/*
+ * Common utilities for the different types of db tables.
+ * Mostly matching etc.
+ */
+
+#ifdef HAVE_CONFIG_H
+#  include "config.h"
+#endif
+
+#include "sys.h"
+#include "erl_vm.h"
+#include "global.h"
+#include "erl_process.h"
+#include "error.h"
+#define ERTS_WANT_DB_INTERNAL__
+#include "erl_db.h"
+#include "bif.h"
+#include "big.h"
+#include "erl_binary.h"
+
+#include "erl_db_util.h"
+
+
+/*
+** Flags for the guard bif's
+*/
+
+/* These are offsets from the DCOMP_* value */
+#define DBIF_GUARD 1
+#define DBIF_BODY  0
+
+/* These are the DBIF flag bits corresponding to the DCOMP_* value.
+ * If a bit is set, the BIF is allowed in that context. */
+#define DBIF_TABLE_GUARD (1 << (DCOMP_TABLE + DBIF_GUARD))
+#define DBIF_TABLE_BODY  (1 << (DCOMP_TABLE + DBIF_BODY))
+#define DBIF_TRACE_GUARD (1 << (DCOMP_TRACE + DBIF_GUARD))
+#define DBIF_TRACE_BODY  (1 << (DCOMP_TRACE + DBIF_BODY))
+#define DBIF_ALL \
+DBIF_TABLE_GUARD | DBIF_TABLE_BODY | DBIF_TRACE_GUARD | DBIF_TRACE_BODY
+
+
+
+/*
+** Some convenience macros for stacks (DMC == db_match_compile)
+*/
+
+#define DMC_DEFAULT_SIZE 25
+
+#define DMC_STACK_TYPE(Type) DMC_##Type##_stack
+
+#define DMC_DECLARE_STACK_TYPE(Type)            \
+typedef struct DMC_STACK_TYPE(Type) {		\
+    int pos;					\
+    int siz;					\
+    Type def[DMC_DEFAULT_SIZE];		        \
+    Type *data;					\
+} DMC_STACK_TYPE(Type)
+    
+#define DMC_INIT_STACK(Name) \
+     (Name).pos = 0; (Name).siz = DMC_DEFAULT_SIZE; (Name).data = (Name).def
+
+#define DMC_STACK_DATA(Name) (Name).data
+
+#define DMC_STACK_NUM(Name) (Name).pos
+
+#define DMC_PUSH(On, What)						\
+do {									\
+    if ((On).pos >= (On).siz) {						\
+	(On).siz *= 2;							\
+	(On).data							\
+	    = (((On).def == (On).data)					\
+	       ? memcpy(erts_alloc(ERTS_ALC_T_DB_MC_STK,		\
+				   (On).siz*sizeof(*((On).data))),	\
+			(On).def,					\
+			DMC_DEFAULT_SIZE*sizeof(*((On).data)))		\
+	       : erts_realloc(ERTS_ALC_T_DB_MC_STK,			\
+			      (void *) (On).data,			\
+			      (On).siz*sizeof(*((On).data))));		\
+    }									\
+    (On).data[(On).pos++] = What;					\
+} while (0)
+
+#define DMC_POP(From) (From).data[--(From).pos]
+
+#define DMC_TOP(From) (From).data[(From).pos - 1]
+
+#define DMC_EMPTY(Name) ((Name).pos == 0)
+
+#define DMC_PEEK(On, At) (On).data[At]     
+
+#define DMC_POKE(On, At, Value) ((On).data[At] = (Value))
+
+#define DMC_CLEAR(Name) (Name).pos = 0
+
+#define DMC_FREE(Name)							\
+do {									\
+    if ((Name).def != (Name).data)					\
+	erts_free(ERTS_ALC_T_DB_MC_STK, (Name).data);			\
+} while (0)
+
+static ERTS_INLINE Process *
+get_proc(Process *cp, Uint32 cp_locks, Eterm id, Uint32 id_locks)
+{
+    Process *proc = erts_pid2proc(cp, cp_locks, id, id_locks);
+    if (!proc && is_atom(id))
+	proc = erts_whereis_process(cp, cp_locks, id, id_locks, 0);
+    return proc;
+}
+
+
+static Eterm
+set_tracee_flags(Process *tracee_p, Eterm tracer, Uint d_flags, Uint e_flags) {
+    Eterm ret;
+    Uint flags;
+
+    if (tracer == NIL) {
+	flags = tracee_p->trace_flags & ~TRACEE_FLAGS;
+    }  else {
+	flags = ((tracee_p->trace_flags & ~d_flags) | e_flags);
+	if (! flags) tracer = NIL;
+    }
+    ret = tracee_p->tracer_proc != tracer || tracee_p->trace_flags != flags
+	? am_true : am_false;
+    tracee_p->tracer_proc = tracer;
+    tracee_p->trace_flags = flags;
+    return ret;
+}
+/*
+** Assuming all locks on tracee_p on entry
+**
+** Changes tracee_p->trace_flags and tracee_p->tracer_proc
+** according to input disable/enable flags and tracer.
+**
+** Returns am_true|am_false on success, am_true if value changed,
+** returns fail_term on failure. Fails if tracer pid or port is invalid.
+*/
+static Eterm 
+set_match_trace(Process *tracee_p, Eterm fail_term, Eterm tracer,
+		Uint d_flags, Uint e_flags) {
+    Eterm ret = fail_term;
+    Process *tracer_p;
+    
+    ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCKS_ALL == 
+		       erts_proc_lc_my_proc_locks(tracee_p));
+
+    if (is_internal_pid(tracer)
+	&& (tracer_p = 
+	    erts_pid2proc(tracee_p, ERTS_PROC_LOCKS_ALL,
+			  tracer, ERTS_PROC_LOCKS_ALL))) {
+	if (tracee_p != tracer_p) {
+	    ret = set_tracee_flags(tracee_p, tracer, d_flags, e_flags);
+	    tracer_p->trace_flags |= tracee_p->trace_flags ? F_TRACER : 0;
+	    erts_smp_proc_unlock(tracer_p, ERTS_PROC_LOCKS_ALL);
+	}
+    } else if (is_internal_port(tracer)) {
+	Port *tracer_port = 
+	    erts_id2port(tracer, tracee_p, ERTS_PROC_LOCKS_ALL);
+	if (tracer_port) {
+	    if (! INVALID_TRACER_PORT(tracer_port, tracer)) {
+		ret = set_tracee_flags(tracee_p, tracer, d_flags, e_flags);
+	    }
+	    erts_smp_port_unlock(tracer_port);
+	}
+    } else {
+	ASSERT(is_nil(tracer));
+	ret = set_tracee_flags(tracee_p, tracer, d_flags, e_flags);
+    }
+    return ret;
+}
+
+
+/* Type checking... */
+
+#define BOXED_IS_TUPLE(Boxed) is_arity_value(*boxed_val((Boxed)))
+
+/*
+**
+** Types and enum's (compiled matches)
+**
+*/
+
+/*
+** match VM instructions
+*/
+typedef enum {
+    matchArray, /* Only when parameter is an array (DCOMP_TRACE) */
+    matchArrayBind, /* ------------- " ------------ */
+    matchTuple,
+    matchPushT,
+    matchPushL,
+    matchPop,
+    matchBind,
+    matchCmp,
+    matchEqBin,
+    matchEqFloat,
+    matchEqBig,
+    matchEqRef,
+    matchEq,
+    matchList,
+    matchSkip,
+    matchPushC,
+    matchConsA, /* Car is below Cdr */
+    matchConsB, /* Cdr is below Car (unusual) */
+    matchMkTuple,
+    matchCall0,
+    matchCall1,
+    matchCall2,
+    matchCall3,
+    matchPushV,
+    matchPushExpr, /* Push the whole expression we're matching ('$_') */
+    matchPushArrayAsList, /* Only when parameter is an Array and 
+			     not an erlang term  (DCOMP_TRACE) */
+    matchPushArrayAsListU, /* As above but unknown size */
+    matchTrue,
+    matchOr,
+    matchAnd,
+    matchOrElse,
+    matchAndAlso,
+    matchJump,
+    matchSelf,
+    matchWaste,
+    matchReturn,
+    matchProcessDump,
+    matchDisplay,
+    matchIsSeqTrace,
+    matchSetSeqToken,
+    matchGetSeqToken,
+    matchSetReturnTrace,
+    matchSetExceptionTrace,
+    matchCatch,
+    matchEnableTrace,
+    matchDisableTrace,
+    matchEnableTrace2,
+    matchDisableTrace2,
+    matchTryMeElse,
+    matchCaller,
+    matchHalt,
+    matchSilent,
+    matchSetSeqTokenFake,
+    matchTrace2,
+    matchTrace3
+} MatchOps;
+
+/*
+** Guard bif's
+*/
+
+typedef struct dmc_guard_bif {
+    Eterm name; /* atom */
+    void *biff;
+    /*    BIF_RETTYPE (*biff)(); */
+    int arity;
+    Uint32 flags;
+} DMCGuardBif; 
+
+/*
+** Error information (for lint)
+*/
+
+/*
+** Type declarations for stacks
+*/
+DMC_DECLARE_STACK_TYPE(Eterm);
+
+DMC_DECLARE_STACK_TYPE(Uint);
+
+DMC_DECLARE_STACK_TYPE(unsigned);
+
+/*
+** Data about the heap during compilation
+*/
+
+typedef struct DMCHeap {
+    int size;
+    unsigned def[DMC_DEFAULT_SIZE];
+    unsigned *data;
+    int used;
+} DMCHeap;
+
+/*
+** Return values from sub compilation steps (guard compilation)
+*/
+
+typedef enum dmc_ret { 
+    retOk, 
+    retFail, 
+    retRestart 
+} DMCRet; 
+
+/*
+** Diverse context information
+*/
+
+typedef struct dmc_context {
+    int stack_need;
+    int stack_used;
+    ErlHeapFragment *save;
+    ErlHeapFragment *copy;
+    Eterm *matchexpr;
+    Eterm *guardexpr;
+    Eterm *bodyexpr;
+    int num_match;
+    int current_match;
+    int eheap_need;
+    Uint cflags;
+    int is_guard; /* 1 if in guard, 0 if in body */
+    int special; /* 1 if the head in the match was a single expression */ 
+    DMCErrInfo *err_info;
+} DMCContext;
+
+/*
+**
+** Global variables 
+**
+*/
+
+/*
+** Internal
+*/
+
+/* 
+** The pseudo process used by the VM (pam).
+*/
+
+#define ERTS_DEFAULT_MS_HEAP_SIZE 128
+
+typedef struct {
+    Process process;
+    Eterm *heap;
+    Eterm default_heap[ERTS_DEFAULT_MS_HEAP_SIZE];
+} ErtsMatchPseudoProcess;
+
+
+#ifdef ERTS_SMP
+static erts_smp_tsd_key_t match_pseudo_process_key;
+#else
+static ErtsMatchPseudoProcess *match_pseudo_process;
+#endif
+
+static ERTS_INLINE void
+cleanup_match_pseudo_process(ErtsMatchPseudoProcess *mpsp, int keep_heap)
+{
+    if (mpsp->process.mbuf
+	|| mpsp->process.off_heap.mso
+#ifndef HYBRID /* FIND ME! */
+	|| mpsp->process.off_heap.funs
+#endif
+	|| mpsp->process.off_heap.externals) {
+	erts_cleanup_empty_process(&mpsp->process);
+    }
+#ifdef DEBUG
+    else {
+	erts_debug_verify_clean_empty_process(&mpsp->process);
+    }
+#endif
+    if (!keep_heap) {
+	if (mpsp->heap != &mpsp->default_heap[0]) {
+	    /* Have to be done *after* call to erts_cleanup_empty_process() */
+	    erts_free(ERTS_ALC_T_DB_MS_RUN_HEAP, (void *) mpsp->heap);
+	    mpsp->heap = &mpsp->default_heap[0];
+	}
+#ifdef DEBUG
+	else {
+	    int i;
+	    for (i = 0; i < ERTS_DEFAULT_MS_HEAP_SIZE; i++) {
+#ifdef ARCH_64
+		mpsp->default_heap[i] = (Eterm) 0xdeadbeefdeadbeef;
+#else
+		mpsp->default_heap[i] = (Eterm) 0xdeadbeef;
+#endif
+	    }
+	}
+#endif
+    }
+}
+
+static ErtsMatchPseudoProcess *
+create_match_pseudo_process(void)
+{
+    ErtsMatchPseudoProcess *mpsp;
+    mpsp = (ErtsMatchPseudoProcess *)erts_alloc(ERTS_ALC_T_DB_MS_PSDO_PROC,
+						sizeof(ErtsMatchPseudoProcess));
+    erts_init_empty_process(&mpsp->process);
+    mpsp->heap = &mpsp->default_heap[0];
+    return mpsp;
+}
+
+static ERTS_INLINE ErtsMatchPseudoProcess *
+get_match_pseudo_process(Process *c_p, Uint heap_size)
+{
+    ErtsMatchPseudoProcess *mpsp;
+#ifdef ERTS_SMP
+    mpsp = (ErtsMatchPseudoProcess *) c_p->scheduler_data->match_pseudo_process;
+    if (mpsp)
+	cleanup_match_pseudo_process(mpsp, 0);
+    else {
+	ASSERT(erts_smp_tsd_get(match_pseudo_process_key) == NULL);
+	mpsp = create_match_pseudo_process();
+	c_p->scheduler_data->match_pseudo_process = (void *) mpsp;
+	erts_smp_tsd_set(match_pseudo_process_key, (void *) mpsp);
+    }
+    ASSERT(mpsp == erts_smp_tsd_get(match_pseudo_process_key));
+    mpsp->process.scheduler_data = c_p->scheduler_data;
+#else
+    mpsp = match_pseudo_process;
+    cleanup_match_pseudo_process(mpsp, 0);
+#endif
+    if (heap_size > ERTS_DEFAULT_MS_HEAP_SIZE)
+	mpsp->heap = (Eterm *) erts_alloc(ERTS_ALC_T_DB_MS_RUN_HEAP,
+					  heap_size*sizeof(Uint));
+    else {
+	ASSERT(mpsp->heap == &mpsp->default_heap[0]);
+    }
+    return mpsp;
+}
+
+#ifdef ERTS_SMP
+static void
+destroy_match_pseudo_process(void)
+{
+    ErtsMatchPseudoProcess *mpsp;
+    mpsp = (ErtsMatchPseudoProcess *)erts_smp_tsd_get(match_pseudo_process_key);
+    if (mpsp) {
+	cleanup_match_pseudo_process(mpsp, 0);
+	erts_free(ERTS_ALC_T_DB_MS_PSDO_PROC, (void *) mpsp);
+	erts_smp_tsd_set(match_pseudo_process_key, (void *) NULL);
+    }
+}
+#endif
+
+static
+void
+match_pseudo_process_init(void)
+{
+#ifdef ERTS_SMP
+    erts_smp_tsd_key_create(&match_pseudo_process_key);
+    erts_smp_install_exit_handler(destroy_match_pseudo_process);
+#else
+    match_pseudo_process = create_match_pseudo_process();
+#endif
+}
+
+void
+erts_match_set_release_result(Process* c_p)
+{
+    (void) get_match_pseudo_process(c_p, 0); /* Clean it up */
+}
+
+/* The trace control word. */
+
+static erts_smp_atomic_t trace_control_word;
+
+
+Eterm
+erts_ets_copy_object(Eterm obj, Process* to)
+{
+    Uint size = size_object(obj);
+    Eterm* hp = HAlloc(to, size);
+    Eterm res;
+
+    res = copy_struct(obj, size, &hp, &MSO(to));
+#ifdef DEBUG
+    if (eq(obj, res) == 0) {
+	erl_exit(1, "copy not equal to source\n");
+    }
+#endif
+    return res;
+}
+
+/* This needs to be here, before the bif table... */
+
+static Eterm db_set_trace_control_word_fake_1(Process *p, Eterm val);
+
+/*
+** The table of callable bif's, i e guard bif's and 
+** some special animals that can provide us with trace
+** information. This array is sorted on init.
+*/
+static DMCGuardBif guard_tab[] =
+{
+    {
+	am_is_atom,
+	&is_atom_1,
+	1,
+	DBIF_ALL
+    },
+    {
+	am_is_float,
+	&is_float_1,
+	1,
+	DBIF_ALL
+    },
+    {
+	am_is_integer,
+	&is_integer_1,
+	1,
+	DBIF_ALL
+    },
+    {
+	am_is_list,
+	&is_list_1,
+	1,
+	DBIF_ALL
+    },
+    {
+	am_is_number,
+	&is_number_1,
+	1,
+	DBIF_ALL
+    },
+    {
+	am_is_pid,
+	&is_pid_1,
+	1,
+	DBIF_ALL
+    },
+    {
+	am_is_port,
+	&is_port_1,
+	1,
+	DBIF_ALL
+    },
+    {
+	am_is_reference,
+	&is_reference_1,
+	1,
+	DBIF_ALL
+    },
+    {
+	am_is_tuple,
+	&is_tuple_1,
+	1,
+	DBIF_ALL
+    },
+    {
+	am_is_binary,
+	&is_binary_1,
+	1,
+	DBIF_ALL
+    },
+    {
+	am_is_function,
+	&is_function_1,
+	1,
+	DBIF_ALL
+    },
+    {
+	am_is_record,
+	&is_record_3,
+	3,
+	DBIF_ALL
+    },
+    {
+	am_abs,
+	&abs_1,
+	1,
+	DBIF_ALL
+    },
+    {
+	am_element,
+	&element_2,
+	2,
+	DBIF_ALL
+    },
+    {
+	am_hd,
+	&hd_1,
+	1,
+	DBIF_ALL
+    },
+    {
+	am_length,
+	&length_1,
+	1,
+	DBIF_ALL
+    },
+    {
+	am_node,
+	&node_1,
+	1,
+	DBIF_ALL
+    },
+    {
+	am_node,
+	&node_0,
+	0,
+	DBIF_ALL
+    },
+    {
+	am_round,
+	&round_1,
+	1,
+	DBIF_ALL
+    },
+    {
+	am_size,
+	&size_1,
+	1,
+	DBIF_ALL
+    },
+    {
+	am_bit_size,
+	&bit_size_1,
+	1,
+	DBIF_ALL
+    },
+    {
+	am_tl,
+	&tl_1,
+	1,
+	DBIF_ALL
+    },
+    {
+	am_trunc,
+	&trunc_1,
+	1,
+	DBIF_ALL
+    },
+    {
+	am_float,
+	&float_1,
+	1,
+	DBIF_ALL
+    },
+    {
+	am_Plus,
+	&splus_1,
+	1,
+	DBIF_ALL
+    },
+    {
+	am_Minus,
+	&sminus_1,
+	1,
+	DBIF_ALL
+    },
+    {
+	am_Plus,
+	&splus_2,
+	2,
+	DBIF_ALL
+    },
+    {
+	am_Minus,
+	&sminus_2,
+	2,
+	DBIF_ALL
+    },
+    {
+	am_Times,
+	&stimes_2,
+	2,
+	DBIF_ALL
+    },
+    {
+	am_Div,
+	&div_2,
+	2,
+	DBIF_ALL
+    },
+    {
+	am_div,
+	&intdiv_2,
+	2,
+	DBIF_ALL
+    },
+    {
+	am_rem,
+	&rem_2,
+	2,
+	DBIF_ALL
+    },
+    {
+	am_band,
+	&band_2,
+	2,
+	DBIF_ALL
+    },
+    {
+	am_bor,
+	&bor_2,
+	2,
+	DBIF_ALL
+    },
+    {
+	am_bxor,
+	&bxor_2,
+	2,
+	DBIF_ALL
+    },
+    {
+	am_bnot,
+	&bnot_1,
+	1,
+	DBIF_ALL
+    },
+    {
+	am_bsl,
+	&bsl_2,
+	2,
+	DBIF_ALL
+    },
+    {
+	am_bsr,
+	&bsr_2,
+	2,
+	DBIF_ALL
+    },
+    {
+	am_Gt,
+	&sgt_2,
+	2,
+	DBIF_ALL
+    },
+    {
+	am_Ge,
+	&sge_2,
+	2,
+	DBIF_ALL
+    },
+    {
+	am_Lt,
+	&slt_2,
+	2,
+	DBIF_ALL
+    },
+    {
+	am_Le,
+	&sle_2,
+	2,
+	DBIF_ALL
+    },
+    {
+	am_Eq,
+	&seq_2,
+	2,
+	DBIF_ALL
+    },
+    {
+	am_Eqeq,
+	&seqeq_2,
+	2,
+	DBIF_ALL
+    },
+    {
+	am_Neq,
+	&sneq_2,
+	2,
+	DBIF_ALL
+    },
+    {
+	am_Neqeq,
+	&sneqeq_2,
+	2,
+	DBIF_ALL
+    },
+    {
+	am_not,
+	&not_1,
+	1,
+	DBIF_ALL
+    },
+    {
+	am_xor,
+	&xor_2,
+	2,
+	DBIF_ALL
+    },
+    {
+	am_get_tcw,
+	&db_get_trace_control_word_0,
+	0,
+	DBIF_TRACE_GUARD | DBIF_TRACE_BODY
+    },
+    {
+	am_set_tcw,
+	&db_set_trace_control_word_1,
+	1,
+	DBIF_TRACE_BODY
+    },
+    {
+	am_set_tcw_fake,
+	&db_set_trace_control_word_fake_1,
+	1,
+	DBIF_TRACE_BODY
+    }
+};
+
+/*
+** Exported
+*/
+Eterm db_am_eot;                /* Atom '$end_of_table' */
+
+/*
+** Forward decl's
+*/
+
+
+/*
+** ... forwards for compiled matches
+*/
+/* Utility code */
+static DMCGuardBif *dmc_lookup_bif(Eterm t, int arity);
+#ifdef DMC_DEBUG
+static Eterm dmc_lookup_bif_reversed(void *f);
+#endif
+static int cmp_uint(void *a, void *b);
+static int cmp_guard_bif(void *a, void *b);
+static int match_compact(ErlHeapFragment *expr, DMCErrInfo *err_info);
+static Uint my_size_object(Eterm t);
+static Eterm my_copy_struct(Eterm t, Eterm **hp, ErlOffHeap* off_heap);
+
+/* Guard compilation */
+static void do_emit_constant(DMCContext *context, DMC_STACK_TYPE(Uint) *text,
+			     Eterm t);
+static DMCRet dmc_list(DMCContext *context,
+		       DMCHeap *heap,
+		       DMC_STACK_TYPE(Uint) *text,
+		       Eterm t,
+		       int *constant);
+static DMCRet dmc_tuple(DMCContext *context,
+		       DMCHeap *heap,
+		       DMC_STACK_TYPE(Uint) *text,
+		       Eterm t,
+		       int *constant);
+static DMCRet dmc_variable(DMCContext *context,
+			   DMCHeap *heap,
+			   DMC_STACK_TYPE(Uint) *text,
+			   Eterm t,
+			   int *constant);
+static DMCRet dmc_fun(DMCContext *context,
+		      DMCHeap *heap,
+		      DMC_STACK_TYPE(Uint) *text,
+		      Eterm t,
+		      int *constant);
+static DMCRet dmc_expr(DMCContext *context,
+		       DMCHeap *heap,
+		       DMC_STACK_TYPE(Uint) *text,
+		       Eterm t,
+		       int *constant);
+static DMCRet compile_guard_expr(DMCContext *context,
+				    DMCHeap *heap,
+				    DMC_STACK_TYPE(Uint) *text,
+				    Eterm t);
+/* match expression subroutine */
+static DMCRet dmc_one_term(DMCContext *context, 
+			   DMCHeap *heap,
+			   DMC_STACK_TYPE(Eterm) *stack,
+			   DMC_STACK_TYPE(Uint) *text,
+			   Eterm c);
+
+
+#ifdef DMC_DEBUG
+static int test_disassemble_next = 0;
+static void db_match_dis(Binary *prog);
+#define TRACE erts_fprintf(stderr,"Trace: %s:%d\n",__FILE__,__LINE__)
+#define FENCE_PATTERN_SIZE 1
+#define FENCE_PATTERN 0xDEADBEEFUL
+#else
+#define TRACE /* Nothing */
+#define FENCE_PATTERN_SIZE 0
+#endif
+static void add_dmc_err(DMCErrInfo *err_info, 
+			   char *str,
+			   int variable,
+			   Eterm term,
+			   DMCErrorSeverity severity);
+
+static Eterm dpm_array_to_list(Process *psp, Eterm *arr, int arity);
+
+static Eterm match_spec_test(Process *p, Eterm against, Eterm spec, int trace);
+
+static Eterm seq_trace_fake(Process *p, Eterm arg1);
+
+
+/*
+** Interface routines.
+*/
+
+/*
+** Pseudo BIF:s to be callable from the PAM VM.
+*/
+
+BIF_RETTYPE db_get_trace_control_word_0(Process *p) 
+{
+    Uint32 tcw = (Uint32) erts_smp_atomic_read(&trace_control_word);
+    BIF_RET(erts_make_integer((Uint) tcw, p));
+}
+
+BIF_RETTYPE db_set_trace_control_word_1(Process *p, Eterm new) 
+{
+    Uint val;
+    Uint32 old_tcw;
+    if (!term_to_Uint(new, &val))
+	BIF_ERROR(p, BADARG);
+    if (val != ((Uint32)val))
+	BIF_ERROR(p, BADARG);
+    
+    old_tcw = (Uint32) erts_smp_atomic_xchg(&trace_control_word, (long) val);
+    BIF_RET(erts_make_integer((Uint) old_tcw, p));
+}
+
+static Eterm db_set_trace_control_word_fake_1(Process *p, Eterm new) 
+{
+    Uint val;
+    if (!term_to_Uint(new, &val))
+	BIF_ERROR(p, BADARG);
+    if (val != ((Uint32)val))
+	BIF_ERROR(p, BADARG);
+    BIF_RET(db_get_trace_control_word_0(p));
+}
+
+/*
+** The API used by the tracer (declared in global.h):
+*/
+
+/*
+** Matchexpr is a list of tuples containing match-code, i e:
+**
+** Matchexpr = [{Pattern, Guards, Body}, ...]
+** Pattern = [ PatternExpr , ...]
+** PatternExpr = Constant | PatternTuple | PatternList | Variable
+** Constant = Any erlang term
+** PatternTuple = { PatternExpr ... }
+** PatternList = [ PatternExpr ]
+** Variable = '$' ++ <number>
+** Guards = [Guard ...]
+** Guard = {GuardFunc, GuardExpr, ...}
+** GuardExpr = BoundVariable | Guard | GuardList | GuardTuple | ConstExpr
+** BoundVariable = Variable (existing in Pattern)  
+** GuardList = [ GuardExpr , ... ]
+** GuardTuple = {{ GuardExpr, ... }}
+** ConstExpr = {const, Constant}
+** GuardFunc = is_list | .... | element | ...
+** Body = [ BodyExpr, ... ]
+** BodyExpr = GuardExpr | { BodyFunc, GuardExpr, ... }
+** BodyFunc = return_trace | seq_trace | trace | ...
+** - or something like that...
+*/
+
+
+Eterm erts_match_set_get_source(Binary *mpsp)
+{
+    MatchProg *prog = Binary2MatchProg(mpsp);
+    return prog->saved_program;
+}
+
+/* This one is for the tracing */
+Binary *erts_match_set_compile(Process *p, Eterm matchexpr) {
+    Binary *bin;
+    Uint sz;
+    Eterm *hp;
+    
+    bin = db_match_set_compile(p, matchexpr, DCOMP_TRACE);
+    if (bin != NULL) {
+	MatchProg *prog = Binary2MatchProg(bin);
+	sz = size_object(matchexpr);
+	prog->saved_program_buf = new_message_buffer(sz);
+	hp = prog->saved_program_buf->mem;
+	prog->saved_program = 
+	    copy_struct(matchexpr, sz, &hp, 
+			&(prog->saved_program_buf->off_heap));
+    }
+    return bin;
+}
+
+Binary *db_match_set_compile(Process *p, Eterm matchexpr, 
+			     Uint flags) 
+{
+    Eterm l;
+    Eterm t;
+    Eterm l2;
+    Eterm *tp;
+    Eterm *hp;
+    int n = 0;
+    int num_heads;
+    int i;
+    Binary *mps = NULL;
+    int compiled = 0;
+    Eterm *matches,*guards, *bodies;
+    Eterm *buff;
+    Eterm sbuff[15];
+
+    if (!is_list(matchexpr))
+	return NULL;
+    num_heads = 0;
+    for (l = matchexpr; is_list(l); l = CDR(list_val(l)))
+	++num_heads;
+
+    if (l != NIL) /* proper list... */
+	return NULL;
+
+    if (num_heads > 5) {
+	buff = erts_alloc(ERTS_ALC_T_DB_TMP,
+			  sizeof(Eterm) * num_heads * 3);
+    } else {
+	buff = sbuff;
+    }
+
+    matches = buff;
+    guards = buff + num_heads;
+    bodies = buff + (num_heads * 2);
+
+    i = 0;
+    for (l = matchexpr; is_list(l); l = CDR(list_val(l))) {
+	t = CAR(list_val(l));
+	if (!is_tuple(t) || arityval((tp = tuple_val(t))[0]) != 3) {
+	    goto error;
+	}
+	if (!(flags & DCOMP_TRACE) || (!is_list(tp[1]) && 
+					!is_nil(tp[1]))) {
+	    t = tp[1];
+	} else {
+	    /* This is when tracing, the parameter is a list,
+	       that I convert to a tuple and that is matched 
+	       against an array (strange, but gives the semantics
+	       of matching against a parameter list) */
+	    n = 0;
+	    for (l2 = tp[1]; is_list(l2); l2 = CDR(list_val(l2))) {
+		++n;
+	    }
+	    if (l2 != NIL) {
+		goto error;
+	    }
+	    hp = HAlloc(p, n + 1);
+	    t = make_tuple(hp);
+	    *hp++ = make_arityval((Uint) n);
+	    l2 = tp[1];
+	    while (n--) {
+		*hp++ = CAR(list_val(l2));
+		l2 = CDR(list_val(l2));
+	    }
+	}
+	matches[i] = t;
+	guards[i] = tp[2];
+	bodies[i] = tp[3];
+	++i;
+    }
+    if ((mps = db_match_compile(matches, guards, bodies,
+				num_heads,
+				flags,
+				NULL)) == NULL) {
+	goto error;
+    }
+    compiled = 1;
+    if (buff != sbuff) {
+	erts_free(ERTS_ALC_T_DB_TMP, buff);
+    }
+    return mps;
+
+error:
+    if (compiled) {
+	erts_bin_free(mps);
+    }
+    if (buff != sbuff) {
+	erts_free(ERTS_ALC_T_DB_TMP, buff);
+    }
+    return NULL;
+}
+
+/* This is used when tracing */
+Eterm erts_match_set_lint(Process *p, Eterm matchexpr) {
+    return db_match_set_lint(p, matchexpr, DCOMP_TRACE);
+}
+
+Eterm db_match_set_lint(Process *p, Eterm matchexpr, Uint flags) 
+{
+    Eterm l;
+    Eterm t;
+    Eterm l2;
+    Eterm *tp;
+    Eterm *hp;
+    DMCErrInfo *err_info = db_new_dmc_err_info();
+    Eterm ret;
+    int n = 0;
+    int num_heads;
+    Binary *mp;
+    Eterm *matches,*guards, *bodies;
+    Eterm sbuff[15];
+    Eterm *buff = sbuff;
+    int i;
+
+    if (!is_list(matchexpr)) {
+	add_dmc_err(err_info, "Match programs are not in a list.", 
+		    -1, 0UL, dmcError);
+	goto done;
+    }
+    num_heads = 0;
+    for (l = matchexpr; is_list(l); l = CDR(list_val(l)))
+	++num_heads;
+
+    if (l != NIL)  { /* proper list... */
+	add_dmc_err(err_info, "Match programs are not in a proper "
+		    "list.", 
+		    -1, 0UL, dmcError);
+	goto done;
+    }
+
+    if (num_heads > 5) {
+	buff = erts_alloc(ERTS_ALC_T_DB_TMP,
+			  sizeof(Eterm) * num_heads * 3);
+    } 
+
+    matches = buff;
+    guards = buff + num_heads;
+    bodies = buff + (num_heads * 2);
+
+    i = 0;
+    for (l = matchexpr; is_list(l); l = CDR(list_val(l))) {
+	t = CAR(list_val(l));
+	if (!is_tuple(t) || arityval((tp = tuple_val(t))[0]) != 3) {
+	    add_dmc_err(err_info, 
+			"Match program part is not a tuple of "
+			"arity 3.", 
+			-1, 0UL, dmcError);
+	    goto done;
+	}
+	if (!(flags & DCOMP_TRACE) || (!is_list(tp[1]) && 
+					!is_nil(tp[1]))) {
+	    t = tp[1];
+	} else {
+	    n = 0;
+	    for (l2 = tp[1]; is_list(l2); l2 = CDR(list_val(l2))) {
+		++n;
+	    }
+	    if (l2 != NIL) {
+		add_dmc_err(err_info, 
+			    "Match expression part %T is not a "
+			    "proper list.", 
+			    -1, tp[1], dmcError);
+		
+		goto done;
+	    }
+	    hp = HAlloc(p, n + 1);
+	    t = make_tuple(hp);
+	    *hp++ = make_arityval((Uint) n);
+	    l2 = tp[1];
+	    while (n--) {
+		*hp++ = CAR(list_val(l2));
+		l2 = CDR(list_val(l2));
+	    }
+	}
+	matches[i] = t;
+	guards[i] = tp[2];
+	bodies[i] = tp[3];
+	++i;
+    }
+    mp = db_match_compile(matches, guards, bodies, num_heads,
+			  flags, err_info); 
+    if (mp != NULL) {
+	erts_bin_free(mp);
+    }
+done:
+    ret = db_format_dmc_err_info(p, err_info);
+    db_free_dmc_err_info(err_info);
+    if (buff != sbuff) {
+	erts_free(ERTS_ALC_T_DB_TMP, buff);
+    }
+    return ret;
+}
+    
+Eterm erts_match_set_run(Process *p, Binary *mpsp, 
+			 Eterm *args, int num_args, 
+			 Uint32 *return_flags) 
+{
+    Eterm ret;
+
+    ret = db_prog_match(p, mpsp,
+			(Eterm) args, 
+			num_args, return_flags);
+#if defined(HARDDEBUG)
+    if (is_non_value(ret)) {
+	erts_fprintf(stderr, "Failed\n");
+    } else {
+	erts_fprintf(stderr, "Returning : %T\n", ret);
+    }
+#endif
+    return ret;
+    /* Returns 
+     *   THE_NON_VALUE if no match
+     *   am_false      if {message,false} has been called,
+     *   am_true       if {message,_} has not been called or
+     *                 if {message,true} has been called,
+     *   Msg           if {message,Msg} has been called.
+     */
+}
+
+/*
+** API Used by other erl_db modules.
+*/
+
+void db_initialize_util(void){
+    qsort(guard_tab, 
+	  sizeof(guard_tab) / sizeof(DMCGuardBif), 
+	  sizeof(DMCGuardBif), 
+	  (int (*)(const void *, const void *)) &cmp_guard_bif);
+    match_pseudo_process_init();
+    erts_smp_atomic_init(&trace_control_word, 0);
+}
+
+
+
+Eterm db_getkey(int keypos, Eterm obj)
+{
+    if (is_tuple(obj)) {
+	Eterm *tptr = tuple_val(obj);
+	if (arityval(*tptr) >= keypos)
+	    return *(tptr + keypos);
+    }
+    return THE_NON_VALUE;
+}
+
+/*
+** Matching compiled (executed by "Pam" :-)
+*/
+
+/*
+** The actual compiling of the match expression and the guards
+*/
+Binary *db_match_compile(Eterm *matchexpr, 
+			 Eterm *guards, 
+			 Eterm *body,
+			 int num_progs,
+			 Uint flags, 
+			 DMCErrInfo *err_info)
+{
+    DMCHeap heap;
+    DMC_STACK_TYPE(Eterm) stack;
+    DMC_STACK_TYPE(Uint) text;
+    DMCContext context;
+    MatchProg *ret = NULL;
+    Eterm t;
+    Uint i;
+    Uint num_iters;
+    int structure_checked;
+    DMCRet res;
+    int current_try_label;
+    Uint max_eheap_need;
+    Binary *bp = NULL;
+    unsigned clause_start;
+
+    DMC_INIT_STACK(stack);
+    DMC_INIT_STACK(text);
+
+    context.stack_need = context.stack_used = 0;
+    context.save = context.copy = NULL;
+    context.num_match = num_progs;
+    context.matchexpr = matchexpr;
+    context.guardexpr = guards;
+    context.bodyexpr = body;
+    context.eheap_need = 0;
+    context.err_info = err_info;
+    context.cflags = flags;
+
+    heap.size = DMC_DEFAULT_SIZE;
+    heap.data = heap.def;
+
+    /*
+    ** Compile the match expression
+    */
+restart:
+    heap.used = 0;
+    max_eheap_need = 0;
+    for (context.current_match = 0; 
+	 context.current_match < num_progs; 
+	 ++context.current_match) { /* This loop is long, 
+				       too long */
+	memset(heap.data, 0, heap.size * sizeof(*heap.data));
+	t = context.matchexpr[context.current_match];
+	context.stack_used = 0;
+	context.eheap_need = 0;
+	structure_checked = 0;
+	if (context.current_match < num_progs - 1) {
+	    DMC_PUSH(text,matchTryMeElse);
+	    current_try_label = DMC_STACK_NUM(text);
+	    DMC_PUSH(text,0);
+	} else {
+	    current_try_label = -1;
+	}
+	clause_start = DMC_STACK_NUM(text); /* the "special" test needs it */
+	DMC_PUSH(stack,NIL);
+	for (;;) {
+	    switch (t & _TAG_PRIMARY_MASK) {
+	    case TAG_PRIMARY_BOXED:
+		if (!BOXED_IS_TUPLE(t)) {
+		    goto simple_term;
+		}
+		num_iters = arityval(*tuple_val(t));
+		if (!structure_checked) { /* i.e. we did not 
+					     pop it */
+		    DMC_PUSH(text,matchTuple);
+		    DMC_PUSH(text,num_iters);
+		}
+		structure_checked = 0;
+		for (i = 1; i <= num_iters; ++i) {
+		    if ((res = dmc_one_term(&context, 
+					    &heap, 
+					    &stack, 
+					    &text, 
+					    tuple_val(t)[i]))
+			!= retOk) {
+			if (res == retRestart) {
+			    goto restart; /* restart the 
+					     surrounding 
+					     loop */
+			} else goto error;
+		    }	    
+		}
+		break;
+	    case TAG_PRIMARY_LIST:
+		if (!structure_checked) {
+		    DMC_PUSH(text, matchList);
+		}
+		structure_checked = 0; /* Whatever it is, we did 
+					  not pop it */
+		if ((res = dmc_one_term(&context, &heap, &stack, 
+					&text, CAR(list_val(t))))
+		    != retOk) {
+		    if (res == retRestart) {
+			goto restart;
+		    } else goto error;
+		}	    
+		t = CDR(list_val(t));
+		continue;
+	    default: /* Nil and non proper tail end's or 
+			single terms as match 
+			expressions */
+	    simple_term:
+		structure_checked = 0;
+		if ((res = dmc_one_term(&context, &heap, &stack, 
+					&text, t))
+		    != retOk) {
+		    if (res == retRestart) {
+			goto restart;
+		    } else goto error;
+		}	    
+		break;
+	    }
+
+	    /* The *program's* stack just *grows* while we are 
+	       traversing one composite data structure, we can 
+	       check the stack usage here */
+
+	    if (context.stack_used > context.stack_need)
+		context.stack_need = context.stack_used;
+
+	    /* We are at the end of one composite data structure, 
+	       pop sub structures and emit a matchPop instruction 
+	       (or break) */
+	    if ((t = DMC_POP(stack)) == NIL) {
+		break;
+	    } else {
+		DMC_PUSH(text, matchPop);
+		structure_checked = 1; /* 
+					* Checked with matchPushT 
+					* or matchPushL
+					*/
+		--(context.stack_used);
+	    }
+	}
+    
+	/* 
+	** There is one single top variable in the match expression
+	** iff the text is tho Uint's and the single instruction 
+	** is 'matchBind' or it is only a skip.
+	*/
+	context.special = 
+	    (DMC_STACK_NUM(text) == 2 + clause_start && 
+	     DMC_PEEK(text,clause_start) == matchBind) || 
+	    (DMC_STACK_NUM(text) == 1 + clause_start && 
+	     DMC_PEEK(text, clause_start) == matchSkip);
+
+	if (flags & DCOMP_TRACE) {
+	    if (context.special) {
+		if (DMC_PEEK(text, clause_start) == matchBind) {
+		    DMC_POKE(text, clause_start, matchArrayBind);
+		} 
+	    } else {
+		ASSERT(DMC_STACK_NUM(text) >= 1);
+		if (DMC_PEEK(text, clause_start) != matchTuple) {
+		    /* If it isn't "special" and the argument is 
+		       not a tuple, the expression is not valid 
+		       when matching an array*/
+		    if (context.err_info) {
+			add_dmc_err(context.err_info, 
+				    "Match head is invalid in "
+				    "this context.", 
+				    -1, 0UL,
+				    dmcError);
+		    }
+		    goto error;
+		}
+		DMC_POKE(text, clause_start, matchArray);
+	    }
+	}
+
+
+	/*
+	** ... and the guards
+	*/
+	context.is_guard = 1;
+	if (compile_guard_expr
+	    (&context,
+	     &heap,
+	     &text,
+	     context.guardexpr[context.current_match]) != retOk) 
+	    goto error;
+	context.is_guard = 0;
+	if ((context.cflags & DCOMP_TABLE) && 
+	    !is_list(context.bodyexpr[context.current_match])) {
+	    if (context.err_info) {
+		add_dmc_err(context.err_info, 
+			    "Body clause does not return "
+			    "anything.", -1, 0UL,
+			    dmcError);
+	    }
+	    goto error;
+	}
+	if (compile_guard_expr
+	    (&context,
+	     &heap,
+	     &text,
+	     context.bodyexpr[context.current_match]) != retOk) 
+	    goto error;
+
+	/*
+	 * The compilation does not bail out when error information
+	 * is requested, so we need to detect that here...
+	 */
+	if (context.err_info != NULL && 
+	    (context.err_info)->error_added) {
+	    goto error;
+	}
+
+
+	/* If the matchprogram comes here, the match is 
+	   successful */
+	DMC_PUSH(text,matchHalt);
+	/* Fill in try-me-else label if there is one. */ 
+	if (current_try_label >= 0) {
+	    DMC_POKE(text, current_try_label, DMC_STACK_NUM(text));
+	}
+	/* So, how much eheap did this part of the match program need? */
+	if (context.eheap_need > max_eheap_need) {
+	    max_eheap_need = context.eheap_need;
+	}
+    } /* for (context.current_match = 0 ...) */
+
+
+    /*
+    ** Done compiling
+    ** Allocate enough space for the program,
+    ** heap size is in 'heap_used', stack size is in 'stack_need'
+    ** and text size is simply DMC_STACK_NUM(text).
+    ** The "program memory" is allocated like this:
+    ** text ----> +-------------+
+    **            |             |
+    **              ..........
+    **            +-------------+
+    **
+    **  The heap-eheap-stack block of a MatchProg is nowadays allocated
+    **  when the match program is run (see db_prog_match()).
+    **
+    ** heap ----> +-------------+
+    **              ..........
+    ** eheap ---> +             +
+    **              ..........
+    ** stack ---> +             +
+    **              ..........
+    **            +-------------+
+    ** The stack is expected to grow towards *higher* adresses.
+    ** A special case is when the match expression is a single binding 
+    ** (i.e '$1'), then the field single_variable is set to 1.
+    */
+    bp = erts_create_magic_binary(((sizeof(MatchProg) - sizeof(Uint)) +
+				   (DMC_STACK_NUM(text) * sizeof(Uint))),
+				  erts_db_match_prog_destructor);
+    ret = Binary2MatchProg(bp);
+    ret->saved_program_buf = NULL;
+    ret->saved_program = NIL;
+    ret->term_save = context.save;
+    ret->num_bindings = heap.used;
+    ret->single_variable = context.special;
+    sys_memcpy(ret->text, DMC_STACK_DATA(text), 
+	       DMC_STACK_NUM(text) * sizeof(Uint));
+    ret->heap_size = ((heap.used * sizeof(Eterm)) +
+		      (max_eheap_need * sizeof(Eterm)) +
+		      (context.stack_need * sizeof(Eterm *)) +
+		      (3 * (FENCE_PATTERN_SIZE * sizeof(Eterm *))));
+    ret->eheap_offset = heap.used + FENCE_PATTERN_SIZE;
+    ret->stack_offset = ret->eheap_offset + max_eheap_need + FENCE_PATTERN_SIZE;
+#ifdef DMC_DEBUG
+    ret->prog_end = ret->text + DMC_STACK_NUM(text);
+#endif
+
+    /* 
+     * Fall through to cleanup code, but context.save should not be free'd
+     */  
+    context.save = NULL;
+error: /* Here is were we land when compilation failed. */
+    while (context.save != NULL) {
+	ErlHeapFragment *ll = context.save->next;
+	free_message_buffer(context.save);
+	context.save = ll;
+    }
+    DMC_FREE(stack);
+    DMC_FREE(text);
+    if (context.copy != NULL) 
+	free_message_buffer(context.copy);
+    if (heap.data != heap.def)
+	erts_free(ERTS_ALC_T_DB_MS_CMPL_HEAP, (void *) heap.data);
+    return bp;
+}
+
+/*
+** Free a match program (in a binary)
+*/
+void erts_db_match_prog_destructor(Binary *bprog)
+{
+    MatchProg *prog;
+    ErlHeapFragment *tmp, *ll;
+    if (bprog == NULL)
+	return;
+    prog = Binary2MatchProg(bprog);
+    tmp = prog->term_save; 
+    while (tmp != NULL) {
+	ll = tmp->next;
+	free_message_buffer(tmp);
+	tmp = ll;
+    }
+    if (prog->saved_program_buf != NULL)
+	free_message_buffer(prog->saved_program_buf);
+}
+
+void
+erts_match_prog_foreach_offheap(Binary *bprog,
+				void (*func)(ErlOffHeap *, void *),
+				void *arg)
+{
+    MatchProg *prog;
+    ErlHeapFragment *tmp;
+    if (bprog == NULL)
+	return;
+    prog = Binary2MatchProg(bprog);
+    tmp = prog->term_save; 
+    while (tmp) {
+	(*func)(&(tmp->off_heap), arg);
+	tmp = tmp->next;
+    }
+    if (prog->saved_program_buf)
+	(*func)(&(prog->saved_program_buf->off_heap), arg);
+}
+
+/*
+** This is not the most efficient way to do it, but it's a rare
+** and not especially nice case when this is used.
+*/
+static Eterm dpm_array_to_list(Process *psp, Eterm *arr, int arity)
+{
+    Eterm *hp = HAlloc(psp, arity * 2);
+    Eterm ret = NIL;
+    while (--arity >= 0) {
+	ret = CONS(hp, arr[arity], ret);
+	hp += 2;
+    }
+    return ret;
+}
+/*
+** Execution of the match program, this is Pam.
+** May return THE_NON_VALUE, which is a bailout.
+** the para meter 'arity' is only used if 'term' is actually an array,
+** i.e. 'DCOMP_TRACE' was specified 
+*/
+Eterm db_prog_match(Process *c_p, Binary *bprog, Eterm term, 
+		    int arity,
+		    Uint32 *return_flags)
+{
+    MatchProg *prog = Binary2MatchProg(bprog);
+    Eterm *ep;
+    Eterm *tp;
+    Eterm t;
+    Eterm **sp;
+    Eterm *esp;
+    Eterm *hp;
+    Uint *pc = prog->text;
+    Eterm *ehp;
+    Eterm ret;
+    Uint n = 0; /* To avoid warning. */
+    int i;
+    unsigned do_catch;
+    ErtsMatchPseudoProcess *mpsp;
+    Process *psp;
+    Process *tmpp;
+    Process *current_scheduled;
+    ErtsSchedulerData *esdp;
+    Eterm (*bif)(Process*, ...);
+    int fail_label;
+    int atomic_trace;
+#ifdef DMC_DEBUG
+    unsigned long *heap_fence;
+    unsigned long *eheap_fence;
+    unsigned long *stack_fence;
+    Uint save_op;
+#endif /* DMC_DEBUG */
+
+    mpsp = get_match_pseudo_process(c_p, prog->heap_size);
+    psp = &mpsp->process;
+
+    /* We need to lure the scheduler into believing in the pseudo process, 
+       because of floating point exceptions. Do *after* mpsp is set!!! */
+
+    esdp = ERTS_GET_SCHEDULER_DATA_FROM_PROC(c_p);
+    ASSERT(esdp != NULL);
+    current_scheduled = esdp->current_process;
+    esdp->current_process = psp;
+    /* SMP: psp->scheduler_data is set by get_match_pseudo_process */
+
+    atomic_trace = 0;
+#define BEGIN_ATOMIC_TRACE(p)                               \
+    do {                                                    \
+	if (! atomic_trace) {                               \
+	    erts_smp_proc_unlock((p), ERTS_PROC_LOCK_MAIN); \
+	    erts_smp_block_system(0);                       \
+            atomic_trace = !0;                              \
+	}                                                   \
+    } while (0)
+#define END_ATOMIC_TRACE(p)                               \
+    do {                                                  \
+	if (atomic_trace) {                               \
+            erts_smp_release_system();                    \
+            erts_smp_proc_lock((p), ERTS_PROC_LOCK_MAIN); \
+            atomic_trace = 0;                             \
+	}                                                 \
+    } while (0)
+
+#ifdef DMC_DEBUG
+    save_op = 0;
+    heap_fence =  (unsigned long *) mpsp->heap + prog->eheap_offset - 1;
+    eheap_fence = (unsigned long *) mpsp->heap + prog->stack_offset - 1;
+    stack_fence = (unsigned long *) mpsp->heap + prog->heap_size - 1;
+    *heap_fence = FENCE_PATTERN;
+    *eheap_fence = FENCE_PATTERN;
+    *stack_fence = FENCE_PATTERN;
+#endif /* DMC_DEBUG */
+
+#ifdef HARDDEBUG
+#define FAIL() {erts_printf("Fail line %d\n",__LINE__); goto fail;}
+#else
+#define FAIL() goto fail
+#endif
+#define FAIL_TERM am_EXIT /* The term to set as return when bif fails and
+			     do_catch != 0 */
+
+    *return_flags = 0U;
+
+restart:
+    ep = &term;
+    esp = mpsp->heap + prog->stack_offset;
+    sp = (Eterm **) esp;
+    hp = mpsp->heap;
+    ehp = mpsp->heap + prog->eheap_offset;
+    ret = am_true;
+    do_catch = 0;
+    fail_label = -1;
+
+    for (;;) {
+#ifdef DMC_DEBUG
+	if (*heap_fence != FENCE_PATTERN) {
+	    erl_exit(1, "Heap fence overwritten in db_prog_match after op "
+		     "0x%08x, overwritten with 0x%08x.", save_op, *heap_fence);
+	}
+	if (*eheap_fence != FENCE_PATTERN) {
+	    erl_exit(1, "Eheap fence overwritten in db_prog_match after op "
+		     "0x%08x, overwritten with 0x%08x.", save_op, 
+		     *eheap_fence);
+	}
+	if (*stack_fence != FENCE_PATTERN) {
+	    erl_exit(1, "Stack fence overwritten in db_prog_match after op "
+		     "0x%08x, overwritten with 0x%08x.", save_op, 
+		     *stack_fence);
+	}
+	save_op = *pc;
+#endif
+	switch (*pc++) {
+	case matchTryMeElse:
+	    fail_label = *pc++;
+	    break;
+	case matchArray: /* only when DCOMP_TRACE, is always first
+			    instruction. */
+	    n = *pc++;
+	    if ((int) n != arity)
+		FAIL();
+	    ep = (Eterm *) *ep;
+	    break;
+	case matchArrayBind: /* When the array size is unknown. */
+	    n = *pc++;
+	    hp[n] = dpm_array_to_list(psp, (Eterm *) term, arity);
+	    break;
+	case matchTuple: /* *ep is a tuple of arity n */
+	    if (!is_tuple(*ep))
+		FAIL();
+	    ep = tuple_val(*ep);
+	    n = *pc++;
+	    if (arityval(*ep) != n)
+		FAIL();
+	    ++ep;
+	    break;
+	case matchPushT: /* *ep is a tuple of arity n, 
+			    push ptr to first element */
+	    if (!is_tuple(*ep))
+		FAIL();
+	    tp = tuple_val(*ep);
+	    n = *pc++;
+	    if (arityval(*tp) != n)
+		FAIL();
+	    *sp++ = tp + 1;
+	    ++ep;
+	    break;
+	case matchList:
+	    if (!is_list(*ep))
+		FAIL();
+	    ep = list_val(*ep);
+	    break;
+	case matchPushL:
+	    if (!is_list(*ep))
+		FAIL();
+	    *sp++ = list_val(*ep);
+	    ++ep;
+	    break;
+	case matchPop:
+	    ep = *(--sp);
+	    break;
+	case matchBind:
+	    n = *pc++;
+	    hp[n] = *ep++;
+	    break;
+	case matchCmp:
+	    n = *pc++;
+	    if (!eq(hp[n],*ep))
+		FAIL();
+	    ++ep;
+	    break;
+	case matchEqBin:
+	    t = (Eterm) *pc++;
+	    if (!eq(*ep,t))
+		FAIL();
+	    ++ep;
+	    break;
+	case matchEqFloat:
+	    if (!is_float(*ep))
+		FAIL();
+	    if (memcmp(float_val(*ep) + 1, pc, sizeof(double)))
+		FAIL();
+	    pc += 2;
+	    ++ep;
+	    break;
+	case matchEqRef:
+	    if (!is_ref(*ep))
+		FAIL();
+	    if (!eq(*ep, make_internal_ref(pc)))
+		FAIL();
+	    i = thing_arityval(*pc);
+	    pc += i+1;
+	    ++ep;
+	    break;
+	case matchEqBig:
+	    if (!is_big(*ep))
+		FAIL();
+	    tp = big_val(*ep);
+	    if (*tp != *pc)
+		FAIL();
+	    i = BIG_ARITY(pc);
+	    while(i--)
+		if (*++tp != *++pc)
+		    FAIL();
+	    ++pc;
+	    ++ep;
+	    break;
+	case matchEq:
+	    t = (Eterm) *pc++; 
+	    if (t != *ep++)
+		FAIL();
+	    break;
+	case matchSkip:
+	    ++ep;
+	    break;
+	/* 
+	 * Here comes guard instructions 
+	 */
+	case matchPushC: /* Push constant */
+	    *esp++ = *pc++;
+	    break;
+	case matchConsA:
+	    ehp[1] = *--esp;
+	    ehp[0] = esp[-1];
+	    esp[-1] = make_list(ehp);
+	    ehp += 2;
+	    break;
+	case matchConsB:
+	    ehp[0] = *--esp;
+	    ehp[1] = esp[-1];
+	    esp[-1] = make_list(ehp);
+	    ehp += 2;
+	    break;
+	case matchMkTuple:
+	    n = *pc++;
+	    t = make_tuple(ehp);
+	    *ehp++ = make_arityval(n);
+	    while (n--) {
+		*ehp++ = *--esp;
+	    }
+	    *esp++ = t;
+	    break;
+	case matchCall0:
+	    bif = (Eterm (*)(Process*, ...)) *pc++;
+	    t = (*bif)(psp);
+	    if (is_non_value(t)) {
+		if (do_catch)
+		    t = FAIL_TERM;
+		else
+		    FAIL();
+	    }
+	    *esp++ = t;
+	    break;
+	case matchCall1:
+	    bif = (Eterm (*)(Process*, ...)) *pc++;
+	    t = (*bif)(psp, esp[-1]);
+	    if (is_non_value(t)) {
+		if (do_catch)
+		    t = FAIL_TERM;
+		else
+		    FAIL();
+	    }
+	    esp[-1] = t;
+	    break;
+	case matchCall2:
+	    bif = (Eterm (*)(Process*, ...)) *pc++;
+	    t = (*bif)(psp, esp[-1], esp[-2]);
+	    if (is_non_value(t)) {
+		if (do_catch)
+		    t = FAIL_TERM;
+		else
+		    FAIL();
+	    }
+	    --esp;
+	    esp[-1] = t;
+	    break;
+	case matchCall3:
+	    bif = (Eterm (*)(Process*, ...)) *pc++;
+	    t = (*bif)(psp, esp[-1], esp[-2], esp[-3]);
+	    if (is_non_value(t)) {
+		if (do_catch)
+		    t = FAIL_TERM;
+		else
+		    FAIL();
+	    }
+	    esp -= 2;
+	    esp[-1] = t;
+	    break;
+	case matchPushV:
+	    *esp++ = hp[*pc++];
+	    break;
+	case matchPushExpr:
+	    *esp++ = term;
+	    break;
+	case matchPushArrayAsList:
+	    n = arity; /* Only happens when 'term' is an array */
+	    tp = (Eterm *) term;
+	    *esp++  = make_list(ehp);
+	    while (n--) {
+		*ehp++ = *tp++;
+		*ehp = make_list(ehp + 1);
+		ehp++; /* As pointed out by Mikael Pettersson the expression
+			  (*ehp++ = make_list(ehp + 1)) that I previously
+			  had written here has undefined behaviour. */
+	    }
+	    ehp[-1] = NIL;
+	    break;
+	case matchPushArrayAsListU:
+	    /* This instruction is NOT efficient. */
+	    *esp++  = dpm_array_to_list(psp, (Eterm *) term, arity); 
+	    break;
+	case matchTrue:
+	    if (*--esp != am_true)
+		FAIL();
+	    break;
+	case matchOr:
+	    n = *pc++;
+	    t = am_false;
+	    while (n--) {
+		if (*--esp == am_true) {
+		    t = am_true;
+		} else if (*esp != am_false) {
+		    esp -= n;
+		    if (do_catch) {
+			t = FAIL_TERM;
+			break;
+		    } else {
+			FAIL();
+		    }
+		}
+	    }
+	    *esp++ = t;
+	    break;
+	case matchAnd:
+	    n = *pc++;
+	    t = am_true;
+	    while (n--) {
+		if (*--esp == am_false) {
+		    t = am_false;
+		} else if (*esp != am_true) {
+		    esp -= n;
+		    if (do_catch) {
+			t = FAIL_TERM;
+			break;
+		    } else {
+			FAIL();
+		    }
+		}
+	    }
+	    *esp++ = t;
+	    break;
+	case matchOrElse:
+	    n = *pc++;
+	    if (*--esp == am_true) {
+		++esp;
+		pc += n;
+	    } else if (*esp != am_false) {
+		if (do_catch) {
+		    *esp++ = FAIL_TERM;
+		    pc += n;
+		} else {
+		    FAIL();
+		}
+	    }
+	    break;
+	case matchAndAlso:
+	    n = *pc++;
+	    if (*--esp == am_false) {
+		esp++;
+		pc += n;
+	    } else if (*esp != am_true) {
+		if (do_catch) {
+		    *esp++ = FAIL_TERM;
+		    pc += n;
+		} else {
+		    FAIL();
+		}
+	    }
+	    break;
+	case matchJump:
+	    n = *pc++;
+	    pc += n;
+	    break;
+	case matchSelf:
+	    *esp++ = c_p->id;
+	    break;
+	case matchWaste:
+	    --esp;
+	    break;
+	case matchReturn:
+	    ret = *--esp;
+	    break;
+	case matchProcessDump: {
+	    erts_dsprintf_buf_t *dsbufp = erts_create_tmp_dsbuf(0);
+	    print_process_info(ERTS_PRINT_DSBUF, (void *) dsbufp, c_p);
+	    *esp++ = new_binary(psp, (byte *)dsbufp->str, (int)dsbufp->str_len);
+	    erts_destroy_tmp_dsbuf(dsbufp);
+	    break;
+	}
+	case matchDisplay: /* Debugging, not for production! */
+	    erts_printf("%T\n", esp[-1]);
+	    esp[-1] = am_true;
+	    break;
+	case matchSetReturnTrace:
+	    *return_flags |= MATCH_SET_RETURN_TRACE;
+	    *esp++ = am_true;
+	    break;
+	case matchSetExceptionTrace:
+	    *return_flags |= MATCH_SET_EXCEPTION_TRACE;
+	    *esp++ = am_true;
+	    break;
+	case matchIsSeqTrace:
+	    if (SEQ_TRACE_TOKEN(c_p) != NIL)
+		*esp++ = am_true;
+	    else
+		*esp++ = am_false;
+	    break;
+	case matchSetSeqToken:
+	    t = erts_seq_trace(c_p, esp[-1], esp[-2], 0);
+	    if (is_non_value(t)) {
+		esp[-2] = FAIL_TERM;
+	    } else {
+		esp[-2] = t;
+	    }
+	    --esp;
+	    break;
+	case matchSetSeqTokenFake:
+	    t = seq_trace_fake(c_p, esp[-1]);
+	    if (is_non_value(t)) {
+		esp[-2] = FAIL_TERM;
+	    } else {
+		esp[-2] = t;
+	    }
+	    --esp;
+	    break;
+	case matchGetSeqToken:
+	    if (SEQ_TRACE_TOKEN(c_p) == NIL) 
+		*esp++ = NIL;
+	    else {
+ 		*esp++ = make_tuple(ehp);
+ 		ehp[0] = make_arityval(5);
+ 		ehp[1] = SEQ_TRACE_TOKEN_FLAGS(c_p);
+ 		ehp[2] = SEQ_TRACE_TOKEN_LABEL(c_p);
+ 		ehp[3] = SEQ_TRACE_TOKEN_SERIAL(c_p);
+ 		ehp[4] = SEQ_TRACE_TOKEN_SENDER(c_p);
+ 		ehp[5] = SEQ_TRACE_TOKEN_LASTCNT(c_p);
+		ASSERT(SEQ_TRACE_TOKEN_ARITY(c_p) == 5);
+		ASSERT(is_immed(ehp[1]));
+		ASSERT(is_immed(ehp[2]));
+		ASSERT(is_immed(ehp[3]));
+		ASSERT(is_immed(ehp[5]));
+		if(!is_immed(ehp[4])) {
+		    Eterm *sender = &ehp[4];
+		    ehp += 6;
+		    *sender = copy_struct(*sender,
+					  size_object(*sender),
+					  &ehp,
+					  &MSO(psp));
+		}
+		else
+		    ehp += 6;
+
+	    } 
+	    break;
+	case matchEnableTrace:
+	    if ( (n = erts_trace_flag2bit(esp[-1]))) {
+		BEGIN_ATOMIC_TRACE(c_p);
+		set_tracee_flags(c_p, c_p->tracer_proc, 0, n);
+		esp[-1] = am_true;
+	    } else {
+		esp[-1] = FAIL_TERM;
+	    }
+	    break;
+	case matchEnableTrace2:
+	    n = erts_trace_flag2bit((--esp)[-1]);
+	    esp[-1] = FAIL_TERM;
+	    if (n) {
+		BEGIN_ATOMIC_TRACE(c_p);
+		if ( (tmpp = get_proc(c_p, 0, esp[0], 0))) {
+		    /* Always take over the tracer of the current process */
+		    set_tracee_flags(tmpp, c_p->tracer_proc, 0, n);
+		    esp[-1] = am_true;
+		}
+	    }
+	    break;
+	case matchDisableTrace:
+	    if ( (n = erts_trace_flag2bit(esp[-1]))) {
+		BEGIN_ATOMIC_TRACE(c_p);
+		set_tracee_flags(c_p, c_p->tracer_proc, n, 0);
+		esp[-1] = am_true;
+	    } else {
+		esp[-1] = FAIL_TERM;
+	    }
+	    break;
+	case matchDisableTrace2:
+	    n = erts_trace_flag2bit((--esp)[-1]);
+	    esp[-1] = FAIL_TERM;
+	    if (n) {
+		BEGIN_ATOMIC_TRACE(c_p);
+		if ( (tmpp = get_proc(c_p, 0, esp[0], 0))) {
+		    /* Always take over the tracer of the current process */
+		    set_tracee_flags(tmpp, c_p->tracer_proc, n, 0);
+		    esp[-1] = am_true;
+		}
+	    }
+	    break;
+ 	case matchCaller:
+ 	    if (!(c_p->cp) || !(hp = find_function_from_pc(c_p->cp))) {
+ 		*esp++ = am_undefined;
+ 	    } else {
+ 		*esp++ = make_tuple(ehp);
+ 		ehp[0] = make_arityval(3);
+ 		ehp[1] = hp[0];
+ 		ehp[2] = hp[1];
+ 		ehp[3] = make_small(hp[2]);
+ 		ehp += 4;
+ 	    }
+ 	    break;
+	case matchSilent:
+	    --esp;
+	    if (*esp == am_true) {
+		erts_smp_proc_lock(c_p, ERTS_PROC_LOCKS_ALL_MINOR);
+		c_p->trace_flags |= F_TRACE_SILENT;
+		erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_ALL_MINOR);
+	    }
+	    else if (*esp == am_false) {
+		erts_smp_proc_lock(c_p, ERTS_PROC_LOCKS_ALL_MINOR);
+		c_p->trace_flags &= ~F_TRACE_SILENT;
+		erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_ALL_MINOR);
+	    }
+	    break;
+	case matchTrace2:
+	    {
+		/*    disable         enable                                */
+		Uint  d_flags  = 0,   e_flags  = 0;  /* process trace flags */
+		Eterm tracer = c_p->tracer_proc;
+		/* XXX Atomicity note: Not fully atomic. Default tracer
+		 * is sampled from current process but applied to
+		 * tracee and tracer later after releasing main
+		 * locks on current process, so c_p->tracer_proc
+		 * may actually have changed when tracee and tracer
+		 * gets updated. I do not think nobody will notice.
+		 * It is just the default value that is not fully atomic.
+		 * and the real argument settable from match spec
+		 * {trace,[],[{{tracer,Tracer}}]} is much, much older.
+		 */
+		int   cputs = 0;
+		
+		if (! erts_trace_flags(esp[-1], &d_flags, &tracer, &cputs) ||
+		    ! erts_trace_flags(esp[-2], &e_flags, &tracer, &cputs) ||
+		    cputs ) {
+		    (--esp)[-1] = FAIL_TERM;
+		    break;
+		}
+		erts_smp_proc_lock(c_p, ERTS_PROC_LOCKS_ALL_MINOR);
+		(--esp)[-1] = set_match_trace(c_p, FAIL_TERM, tracer,
+					      d_flags, e_flags);
+		erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_ALL_MINOR);
+	    }
+	    break;
+	case matchTrace3:
+	    {
+		/*    disable         enable                                */
+		Uint  d_flags  = 0,   e_flags  = 0;  /* process trace flags */
+		Eterm tracer = c_p->tracer_proc;
+		/* XXX Atomicity note. Not fully atomic. See above. 
+		 * Above it could possibly be solved, but not here.
+		 */
+		int   cputs = 0;
+		Eterm tracee = (--esp)[0];
+		
+		if (! erts_trace_flags(esp[-1], &d_flags, &tracer, &cputs) ||
+		    ! erts_trace_flags(esp[-2], &e_flags, &tracer, &cputs) ||
+		    cputs ||
+		    ! (tmpp = get_proc(c_p, ERTS_PROC_LOCK_MAIN, 
+				       tracee, ERTS_PROC_LOCKS_ALL))) {
+		    (--esp)[-1] = FAIL_TERM;
+		    break;
+		}
+		if (tmpp == c_p) {
+		    (--esp)[-1] = set_match_trace(c_p, FAIL_TERM, tracer,
+						  d_flags, e_flags);
+		    erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_ALL_MINOR);
+		} else {
+		    erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN);
+		    (--esp)[-1] = set_match_trace(tmpp, FAIL_TERM, tracer,
+						  d_flags, e_flags);
+		    erts_smp_proc_unlock(tmpp, ERTS_PROC_LOCKS_ALL);
+		    erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MAIN);
+		}
+	    }
+	    break;
+	case matchCatch:
+	    do_catch = 1;
+	    break;
+	case matchHalt:
+	    goto success;
+	default:
+	    erl_exit(1, "Internal error: unexpected opcode in match program.");
+	}
+    }
+fail:
+    *return_flags = 0U;
+    if (fail_label >= 0) { /* We failed during a "TryMeElse", 
+			      lets restart, with the next match 
+			      program */
+	pc = (prog->text) + fail_label;
+	cleanup_match_pseudo_process(mpsp, 1);
+	goto restart;
+    }
+    ret = THE_NON_VALUE;
+success:
+
+#ifdef DMC_DEBUG
+    if (*heap_fence != FENCE_PATTERN) {
+	erl_exit(1, "Heap fence overwritten in db_prog_match after op "
+		 "0x%08x, overwritten with 0x%08x.", save_op, *heap_fence);
+    }
+    if (*eheap_fence != FENCE_PATTERN) {
+	erl_exit(1, "Eheap fence overwritten in db_prog_match after op "
+		 "0x%08x, overwritten with 0x%08x.", save_op, 
+		 *eheap_fence);
+    }
+    if (*stack_fence != FENCE_PATTERN) {
+	erl_exit(1, "Stack fence overwritten in db_prog_match after op "
+		 "0x%08x, overwritten with 0x%08x.", save_op, 
+		 *stack_fence);
+    }
+#endif
+
+    esdp->current_process = current_scheduled;
+
+    END_ATOMIC_TRACE(c_p);
+    return ret;
+#undef FAIL
+#undef FAIL_TERM
+#undef BEGIN_ATOMIC_TRACE
+#undef END_ATOMIC_TRACE
+}
+
+
+/*
+ * Convert a match program to a "magic" binary to return up to erlang
+ */
+Eterm db_make_mp_binary(Process *p, Binary *mp, Eterm **hpp) {
+    return erts_mk_magic_binary_term(hpp, &MSO(p), mp);
+}
+
+DMCErrInfo *db_new_dmc_err_info(void) 
+{
+    DMCErrInfo *ret = erts_alloc(ERTS_ALC_T_DB_DMC_ERR_INFO,
+				 sizeof(DMCErrInfo));
+    ret->var_trans = NULL;
+    ret->num_trans = 0;
+    ret->error_added = 0;
+    ret->first = NULL;
+    return ret;
+}
+
+Eterm db_format_dmc_err_info(Process *p, DMCErrInfo *ei)
+{
+    int sl;
+    int vnum;
+    DMCError *tmp;
+    Eterm *shp;
+    Eterm ret = NIL;
+    Eterm tlist, tpl, sev;
+    char buff[DMC_ERR_STR_LEN + 20 /* for the number */];
+
+    for (tmp = ei->first; tmp != NULL; tmp = tmp->next) {
+	if (tmp->variable >= 0 && 
+	    tmp->variable < ei->num_trans &&
+	    ei->var_trans != NULL) {
+	    vnum = (int) ei->var_trans[tmp->variable];
+	} else {
+	    vnum = tmp->variable;
+	}
+	if (vnum >= 0)
+	    sprintf(buff,tmp->error_string, vnum);
+	else
+	    strcpy(buff,tmp->error_string);
+	sl = strlen(buff);
+	shp = HAlloc(p, sl * 2 + 5);
+	sev = (tmp->severity == dmcWarning) ? 
+	    am_atom_put("warning",7) :
+	    am_error;
+	tlist = buf_to_intlist(&shp, buff, sl, NIL);
+	tpl = TUPLE2(shp, sev, tlist);
+	shp += 3;
+	ret = CONS(shp, tpl, ret);
+	shp += 2;
+    }
+    return ret;
+}
+
+void db_free_dmc_err_info(DMCErrInfo *ei){
+    while (ei->first != NULL) {
+	DMCError *ll = ei->first->next;
+	erts_free(ERTS_ALC_T_DB_DMC_ERROR, ei->first);
+	ei->first = ll;
+    }
+    if (ei->var_trans)
+	erts_free(ERTS_ALC_T_DB_TRANS_TAB, ei->var_trans);
+    erts_free(ERTS_ALC_T_DB_DMC_ERR_INFO, ei);
+}
+
+/* Calculate integer addition: counter+incr.
+** Store bignum in *hpp and increase *hpp accordingly.
+** *hpp is assumed to be large enough to hold the result.
+*/
+Eterm db_add_counter(Eterm** hpp, Eterm counter, Eterm incr)
+{
+    Eterm big_tmp[2];
+    Eterm res;
+    Sint ires;
+    Eterm arg1;
+    Eterm arg2;
+
+    if (is_both_small(counter,incr)) {
+	ires = signed_val(counter) + signed_val(incr);
+	if (IS_SSMALL(ires)) {
+	    return make_small(ires);
+	} else {
+	    res = small_to_big(ires, *hpp);
+	    ASSERT(BIG_NEED_SIZE(big_size(res))==2);
+	    *hpp += 2;
+	    return res;
+	}
+    }
+    else {
+	switch(NUMBER_CODE(counter, incr)) {
+	case SMALL_BIG:
+	    arg1 = small_to_big(signed_val(counter), big_tmp);
+	    arg2 = incr;
+	    break;
+	case BIG_SMALL:
+	    arg1 = counter;
+	    arg2 = small_to_big(signed_val(incr), big_tmp);
+	    break;
+	case BIG_BIG:
+	    arg1 = incr;
+	    arg2 = counter;
+	    break;
+	default:
+	    return THE_NON_VALUE;
+	}
+	res = big_plus(arg1, arg2, *hpp);
+	if (is_big(res)) {
+	    *hpp += BIG_NEED_SIZE(big_size(res));
+	}
+	return res;
+    }
+}
+
+/*
+** Update one element:
+** handle:   Initialized by db_lookup_dbterm()
+** position: The tuple position of the elements to be updated.
+** newval:   The new value of the element.
+** Can not fail.
+*/
+void db_do_update_element(DbUpdateHandle* handle,
+			  Sint position,
+			  Eterm newval)
+{
+    Eterm oldval = handle->dbterm->tpl[position];
+    Eterm* newp;
+    Eterm* oldp;
+    Uint newval_sz;
+    Uint oldval_sz;
+
+    if (is_both_immed(newval,oldval)) {
+	handle->dbterm->tpl[position] = newval;
+	return;
+    }
+    else if (!handle->mustResize && is_boxed(newval)) {
+	newp = boxed_val(newval);
+	switch (*newp & _TAG_HEADER_MASK) {
+	case _TAG_HEADER_POS_BIG:
+	case _TAG_HEADER_NEG_BIG:
+	case _TAG_HEADER_FLOAT:
+	case _TAG_HEADER_HEAP_BIN:	    
+	    newval_sz = header_arity(*newp) + 1;	    
+	    if (is_boxed(oldval)) {
+		oldp = boxed_val(oldval);
+		switch (*oldp & _TAG_HEADER_MASK) {
+		case _TAG_HEADER_POS_BIG:
+		case _TAG_HEADER_NEG_BIG:
+		case _TAG_HEADER_FLOAT:
+		case _TAG_HEADER_HEAP_BIN:
+		    oldval_sz = header_arity(*oldp) + 1;
+		    if (oldval_sz == newval_sz) {
+			/* "self contained" terms of same size, do memcpy */
+			sys_memcpy(oldp, newp, newval_sz*sizeof(Eterm));			
+			return;
+		    }
+		    goto both_size_set;
+		}
+	    }
+	    goto new_size_set;
+	}
+    }
+    /* Not possible for simple memcpy or dbterm is already non-contiguous, */
+    /* need to realloc... */
+
+    newval_sz = is_immed(newval) ? 0 : size_object(newval);
+new_size_set:
+	
+    oldval_sz = is_immed(oldval) ? 0 : size_object(oldval);
+both_size_set:
+
+    handle->new_size = handle->new_size - oldval_sz + newval_sz;
+
+    /* write new value in old dbterm, finalize will make a flat copy */	
+    handle->dbterm->tpl[position] = newval;
+    handle->mustResize = 1;
+}
+
+
+/*
+** Copy the object into a possibly new DbTerm, 
+** offset is the offset of the DbTerm from the start
+** of the sysAllocaed structure, The possibly realloced and copied
+** structure is returned. Make sure (((char *) old) - offset) is a 
+** pointer to a ERTS_ALC_T_DB_TERM allocated data area.
+*/
+void* db_get_term(DbTableCommon *tb, DbTerm* old, Uint offset, Eterm obj)
+{
+    int size = size_object(obj);
+    void *structp = ((char*) old) - offset;
+    DbTerm* p;
+    Eterm copy;
+    Eterm *top;
+
+    if (old != 0) {
+	erts_cleanup_offheap(&old->off_heap);
+	if (size == old->size) {
+	    p = old;
+	} else {
+	    Uint new_sz = offset + sizeof(DbTerm) + sizeof(Eterm)*(size-1);
+	    Uint old_sz = offset + sizeof(DbTerm) + sizeof(Eterm)*(old->size-1);
+
+	    if (erts_ets_realloc_always_moves) {
+		void *nstructp = erts_db_alloc(ERTS_ALC_T_DB_TERM,
+					       (DbTable *) tb,
+					       new_sz);
+		memcpy(nstructp,structp,offset);
+		erts_db_free(ERTS_ALC_T_DB_TERM,
+			     (DbTable *) tb,
+			     structp,
+			     old_sz);
+		structp = nstructp;
+	    } else {
+		structp = erts_db_realloc(ERTS_ALC_T_DB_TERM,
+					  (DbTable *) tb,
+					  structp,
+					  old_sz,
+					  new_sz);
+	    }
+	    p = (DbTerm*) ((void *)(((char *) structp) + offset));
+	}
+    }
+    else {
+	structp = erts_db_alloc(ERTS_ALC_T_DB_TERM,
+				(DbTable *) tb,
+				(offset
+				 + sizeof(DbTerm)
+				 + sizeof(Eterm)*(size-1)));
+	p = (DbTerm*) ((void *)(((char *) structp) + offset));
+    }
+    p->size = size;
+    p->off_heap.mso = NULL;
+    p->off_heap.externals = NULL;
+#ifndef HYBRID /* FIND ME! */
+    p->off_heap.funs = NULL;
+#endif
+    p->off_heap.overhead = 0;
+
+    top = DBTERM_BUF(p);
+    copy = copy_struct(obj, size, &top, &p->off_heap);
+    DBTERM_SET_TPL(p,tuple_val(copy));
+
+    return structp;
+}
+
+
+void db_free_term_data(DbTerm* p)
+{
+    erts_cleanup_offheap(&p->off_heap);
+}
+
+
+/*
+** Check if object represents a "match" variable 
+** i.e and atom $N where N is an integer 
+**
+*/
+
+int db_is_variable(Eterm obj)
+{
+    byte *b;
+    int n;
+    int N;
+
+    if (is_not_atom(obj))
+        return -1;
+    b = atom_tab(atom_val(obj))->name;
+    if ((n = atom_tab(atom_val(obj))->len) < 2)
+        return -1;
+    if (*b++ != '$')
+        return -1;
+    n--;
+    /* Handle first digit */
+    if (*b == '0')
+        return (n == 1) ? 0 : -1;
+    if (*b >= '1' && *b <= '9')
+        N = *b++ - '0';
+    else
+        return -1;
+    n--;
+    while(n--) {
+        if (*b >= '0' && *b <= '9') {
+            N = N*10 + (*b - '0');
+            b++;
+        }
+        else
+            return -1;
+    }
+    return N;
+}
+
+
+/* check if obj is (or contains) a variable */
+/* return 1 if obj contains a variable or underscore */
+/* return 0 if obj is fully ground                   */
+
+int db_has_variable(Eterm obj)
+{
+    switch(obj & _TAG_PRIMARY_MASK) {
+    case TAG_PRIMARY_LIST: {
+	while (is_list(obj)) {
+	    if (db_has_variable(CAR(list_val(obj))))
+		return 1;
+	    obj = CDR(list_val(obj));
+	}
+	return(db_has_variable(obj));  /* Non wellformed list or [] */
+    }
+    case TAG_PRIMARY_BOXED: 
+	if (!BOXED_IS_TUPLE(obj)) {
+	    return 0;
+	} else {
+	    Eterm *tuple = tuple_val(obj);
+	    int arity = arityval(*tuple++);
+	    while(arity--) {
+		if (db_has_variable(*tuple))
+		    return 1;
+		tuple++;
+	    }
+	    return(0);
+	}
+    case TAG_PRIMARY_IMMED1:
+	if (obj == am_Underscore || db_is_variable(obj) >= 0)
+	    return 1;
+    }
+    return 0;
+}
+
+int erts_db_is_compiled_ms(Eterm term)
+{
+    return (is_binary(term)
+	    && (thing_subtag(*binary_val(term)) == REFC_BINARY_SUBTAG)
+	    && IsMatchProgBinary((((ProcBin *) binary_val(term))->val)));
+}
+
+/* 
+** Local (static) utilities.
+*/
+
+/*
+***************************************************************************
+** Compiled matches 
+***************************************************************************
+*/
+/*
+** Utility to add an error
+*/
+
+static void add_dmc_err(DMCErrInfo *err_info, 
+			char *str,
+			int variable,
+			Eterm term,
+			DMCErrorSeverity severity)
+{
+    /* Linked in in reverse order, to ease the formatting */
+    DMCError *e = erts_alloc(ERTS_ALC_T_DB_DMC_ERROR, sizeof(DMCError));
+    if (term != 0UL) {
+	erts_snprintf(e->error_string, DMC_ERR_STR_LEN, str, term);
+    } else {
+	strncpy(e->error_string, str, DMC_ERR_STR_LEN);
+	e->error_string[DMC_ERR_STR_LEN] ='\0';
+    }
+    e->variable = variable;
+    e->severity = severity;
+    e->next = err_info->first;
+#ifdef HARDDEBUG
+    erts_fprintf(stderr,"add_dmc_err: %s\n",e->error_string);
+#endif
+    err_info->first = e;
+    if (severity >= dmcError)
+	err_info->error_added = 1;
+}
+    
+/*
+** Handle one term in the match expression (not the guard) 
+*/
+static DMCRet dmc_one_term(DMCContext *context, 
+			   DMCHeap *heap,
+			   DMC_STACK_TYPE(Eterm) *stack,
+			   DMC_STACK_TYPE(Uint) *text,
+			   Eterm c)
+{
+    Sint n;
+    Eterm *hp;
+    ErlHeapFragment *tmp_mb;
+    Uint sz, sz2, sz3;
+    Uint i, j;
+
+
+    switch (c & _TAG_PRIMARY_MASK) {
+    case TAG_PRIMARY_IMMED1:
+	if ((n = db_is_variable(c)) >= 0) { /* variable */
+	    if (n >= heap->size) {
+		/*
+		** Ouch, big integer in match variable.
+		*/
+		Eterm *save_hp;
+		ASSERT(heap->data == heap->def);
+		sz = sz2 = sz3 = 0;
+		for (j = 0; j < context->num_match; ++j) {
+		    sz += size_object(context->matchexpr[j]);
+		    sz2 += size_object(context->guardexpr[j]);
+		    sz3 += size_object(context->bodyexpr[j]);
+		}
+		context->copy = 
+		    new_message_buffer(sz + sz2 + sz3 +
+				       context->num_match);
+		save_hp = hp = context->copy->mem;
+		hp += context->num_match;
+		for (j = 0; j < context->num_match; ++j) {
+		    context->matchexpr[j] = 
+			copy_struct(context->matchexpr[j], 
+				    size_object(context->matchexpr[j]), &hp, 
+				    &(context->copy->off_heap));
+		    context->guardexpr[j] = 
+			copy_struct(context->guardexpr[j], 
+				    size_object(context->guardexpr[j]), &hp, 
+				    &(context->copy->off_heap));
+		    context->bodyexpr[j] = 
+			copy_struct(context->bodyexpr[j], 
+				    size_object(context->bodyexpr[j]), &hp, 
+				    &(context->copy->off_heap));
+		}
+		for (j = 0; j < context->num_match; ++j) {
+		    /* the actual expressions can be 
+		       atoms in their selves, place them first */
+		    *save_hp++ = context->matchexpr[j]; 
+		}
+		heap->size = match_compact(context->copy, 
+					   context->err_info);
+		for (j = 0; j < context->num_match; ++j) {
+		    /* restore the match terms, as they
+		       may be atoms that changed */
+		    context->matchexpr[j] = context->copy->mem[j];
+		}
+		heap->data = erts_alloc(ERTS_ALC_T_DB_MS_CMPL_HEAP,
+					heap->size*sizeof(unsigned));
+		sys_memset(heap->data, 0, 
+			   heap->size * sizeof(unsigned));
+		DMC_CLEAR(*stack);
+		/*DMC_PUSH(*stack,NIL);*/
+		DMC_CLEAR(*text);
+		return retRestart;
+	    }
+	    if (heap->data[n]) { /* already bound ? */
+		DMC_PUSH(*text,matchCmp);
+		DMC_PUSH(*text,n);
+	    } else { /* Not bound, bind! */
+		if (n >= heap->used)
+		    heap->used = n + 1;
+		DMC_PUSH(*text,matchBind);
+		DMC_PUSH(*text,n);
+		heap->data[n] = 1;
+	    }
+	} else if (c == am_Underscore) {
+	    DMC_PUSH(*text, matchSkip);
+	} else { /* Any immediate value */
+	    DMC_PUSH(*text, matchEq);
+	    DMC_PUSH(*text, (Uint) c);
+	}
+	break;
+    case TAG_PRIMARY_LIST:
+	DMC_PUSH(*text, matchPushL);
+	++(context->stack_used);
+	DMC_PUSH(*stack, c); 
+	break;
+    case TAG_PRIMARY_BOXED: {
+	Eterm hdr = *boxed_val(c);
+	switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
+	case (_TAG_HEADER_ARITYVAL >> _TAG_PRIMARY_SIZE):    
+	    n = arityval(*tuple_val(c));
+	    DMC_PUSH(*text, matchPushT);
+	    ++(context->stack_used);
+	    DMC_PUSH(*text, n);
+	    DMC_PUSH(*stack, c);
+	    break;
+	case (_TAG_HEADER_REF >> _TAG_PRIMARY_SIZE):
+	    n = thing_arityval(*internal_ref_val(c));
+	    DMC_PUSH(*text, matchEqRef);
+	    DMC_PUSH(*text, *internal_ref_val(c));
+	    for (i = 1; i <= n; ++i) {
+		DMC_PUSH(*text, (Uint) internal_ref_val(c)[i]);
+	    }
+	    break;
+	case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
+	case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
+	    n = thing_arityval(*big_val(c));
+	    DMC_PUSH(*text, matchEqBig);
+	    DMC_PUSH(*text, *big_val(c));
+	    for (i = 1; i <= n; ++i) {
+		DMC_PUSH(*text, (Uint) big_val(c)[i]);
+	    }
+	    break;
+	case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
+	    DMC_PUSH(*text,matchEqFloat);
+	    DMC_PUSH(*text, (Uint) float_val(c)[1]);
+	    /* XXX: this reads and pushes random junk on ARCH_64 */
+	    DMC_PUSH(*text, (Uint) float_val(c)[2]);
+	    break;
+	default: /* BINARY, FUN, VECTOR, or EXTERNAL */
+	    /*
+	    ** Make a private copy...
+	    */
+	    n = size_object(c);
+	    tmp_mb = new_message_buffer(n);
+	    hp = tmp_mb->mem;
+	    DMC_PUSH(*text, matchEqBin);
+	    DMC_PUSH(*text, copy_struct(c, n, &hp, &(tmp_mb->off_heap)));
+	    tmp_mb->next = context->save;
+	    context->save = tmp_mb;
+	    break;
+	}
+	break;
+    }
+    default:
+	erl_exit(1, "db_match_compile: "
+		 "Bad object on heap: 0x%08lx\n",
+		 (unsigned long) c);
+    }
+    return retOk;
+}
+
+/*
+** Match guard compilation
+*/
+
+static void do_emit_constant(DMCContext *context, DMC_STACK_TYPE(Uint) *text,
+			     Eterm t) 
+{
+	int sz;
+	ErlHeapFragment *emb;
+	Eterm *hp;
+	Eterm tmp;
+
+	if (IS_CONST(t)) {
+	    tmp = t;
+	} else {
+	    sz = my_size_object(t);
+	    emb = new_message_buffer(sz);
+	    hp = emb->mem;
+	    tmp = my_copy_struct(t,&hp,&(emb->off_heap));
+	    emb->next = context->save;
+	    context->save = emb;
+	}
+	DMC_PUSH(*text,matchPushC);
+	DMC_PUSH(*text,(Uint) tmp);
+	if (++context->stack_used > context->stack_need)
+	    context->stack_need = context->stack_used;
+}
+
+#define RETURN_ERROR_X(String, X, Y, ContextP, ConstantF)        \
+do {                                                            \
+if ((ContextP)->err_info != NULL) {				\
+    (ConstantF) = 0;						\
+    add_dmc_err((ContextP)->err_info, String, X, Y, dmcError);  \
+    return retOk;						\
+} else 								\
+  return retFail;                                                \
+} while(0)
+
+#define RETURN_ERROR(String, ContextP, ConstantF) \
+     RETURN_ERROR_X(String, -1, 0UL, ContextP, ConstantF)
+
+#define RETURN_VAR_ERROR(String, N, ContextP, ConstantF) \
+     RETURN_ERROR_X(String, N, 0UL, ContextP, ConstantF)
+
+#define RETURN_TERM_ERROR(String, T, ContextP, ConstantF) \
+     RETURN_ERROR_X(String, -1, T, ContextP, ConstantF)
+
+#define WARNING(String, ContextP) \
+add_dmc_err((ContextP)->err_info, String, -1, 0UL, dmcWarning)
+
+#define VAR_WARNING(String, N, ContextP) \
+add_dmc_err((ContextP)->err_info, String, N, 0UL, dmcWarning)
+
+#define TERM_WARNING(String, T, ContextP) \
+add_dmc_err((ContextP)->err_info, String, -1, T, dmcWarning)
+
+static DMCRet dmc_list(DMCContext *context,
+		       DMCHeap *heap,
+		       DMC_STACK_TYPE(Uint) *text,
+		       Eterm t,
+		       int *constant)
+{
+    int c1;
+    int c2;
+    int ret;
+
+    if ((ret = dmc_expr(context, heap, text, CAR(list_val(t)), &c1)) != retOk)
+	return ret;
+
+    if ((ret = dmc_expr(context, heap, text, CDR(list_val(t)), &c2)) != retOk)
+	return ret;
+
+    if (c1 && c2) {
+	*constant = 1;
+	return retOk;
+    } 
+    *constant = 0;
+    if (!c1) {
+	/* The CAR is not a constant, so if the CDR is, we just push it,
+	   otherwise it is already pushed. */
+	if (c2)
+	    do_emit_constant(context, text, CDR(list_val(t)));
+	DMC_PUSH(*text, matchConsA);
+    } else { /* !c2 && c1 */
+	do_emit_constant(context, text, CAR(list_val(t)));
+	DMC_PUSH(*text, matchConsB);
+    }
+    --context->stack_used; /* Two objects on stack becomes one */
+    context->eheap_need += 2;
+    return retOk;
+}
+
+static DMCRet dmc_tuple(DMCContext *context,
+		       DMCHeap *heap,
+		       DMC_STACK_TYPE(Uint) *text,
+		       Eterm t,
+		       int *constant)
+{
+    DMC_STACK_TYPE(Uint) instr_save;
+    int all_constant = 1;
+    int textpos = DMC_STACK_NUM(*text);
+    Eterm *p = tuple_val(t);
+    Uint nelems = arityval(*p);
+    Uint i;
+    int c;
+    DMCRet ret;
+
+    /*
+    ** We remember where we started to layout code, 
+    ** assume all is constant and back up and restart if not so.
+    ** The tuple should be laid out with the last element first,
+    ** so we can memcpy the tuple to the eheap.
+    */
+    for (i = nelems; i > 0; --i) {
+	if ((ret = dmc_expr(context, heap, text, p[i], &c)) != retOk)
+	    return ret;
+	if (!c && all_constant) {
+	    all_constant = 0;
+	    if (i < nelems) {
+		Uint j;
+
+		/*
+		 * Oops, we need to relayout the constants.
+		 * Save the already laid out instructions.
+		 */
+		DMC_INIT_STACK(instr_save);
+		while (DMC_STACK_NUM(*text) > textpos) 
+		    DMC_PUSH(instr_save, DMC_POP(*text));
+		for (j = nelems; j > i; --j)
+		    do_emit_constant(context, text, p[j]);
+		while(!DMC_EMPTY(instr_save))
+		    DMC_PUSH(*text, DMC_POP(instr_save));
+		DMC_FREE(instr_save);
+	    }
+	} else if (c && !all_constant) {
+	    /* push a constant */
+	    do_emit_constant(context, text, p[i]);
+	}
+    }
+    
+    if (all_constant) {
+	*constant = 1;
+	return retOk;
+    }
+    DMC_PUSH(*text, matchMkTuple);
+    DMC_PUSH(*text, nelems);
+    context->stack_used -= (nelems - 1);
+    context->eheap_need += (nelems + 1);
+    *constant = 0;
+    return retOk;
+}
+
+static DMCRet dmc_whole_expression(DMCContext *context,
+				   DMCHeap *heap,
+				   DMC_STACK_TYPE(Uint) *text,
+				   Eterm t,
+				   int *constant)
+{
+    if (context->cflags & DCOMP_TRACE) {
+	/* Hmmm, convert array to list... */
+	if (context->special) {
+	   DMC_PUSH(*text, matchPushArrayAsListU);
+	} else { 
+	    ASSERT(is_tuple(context->matchexpr
+			    [context->current_match]));
+	    context->eheap_need += 
+		arityval(*(tuple_val(context->matchexpr
+				     [context->current_match]))) * 2;
+	    DMC_PUSH(*text, matchPushArrayAsList);
+	}
+    } else {
+	DMC_PUSH(*text, matchPushExpr);
+    }
+    ++context->stack_used;
+    if (context->stack_used > context->stack_need)
+	context->stack_need = context->stack_used;
+    *constant = 0;
+    return retOk;
+}
+
+static DMCRet dmc_variable(DMCContext *context,
+			   DMCHeap *heap,
+			   DMC_STACK_TYPE(Uint) *text,
+			   Eterm t,
+			   int *constant)
+{
+    Uint n = db_is_variable(t);
+    ASSERT(n >= 0);
+    if (n >= heap->used) 
+	RETURN_VAR_ERROR("Variable $%d is unbound.", n, context, *constant);
+    if (heap->data[n] == 0U)
+	RETURN_VAR_ERROR("Variable $%d is unbound.", n, context, *constant);
+    DMC_PUSH(*text, matchPushV);
+    DMC_PUSH(*text, n);
+    ++context->stack_used;
+    if (context->stack_used > context->stack_need)
+	context->stack_need = context->stack_used;
+    *constant = 0;
+    return retOk;
+}
+
+static DMCRet dmc_all_bindings(DMCContext *context,
+			       DMCHeap *heap,
+			       DMC_STACK_TYPE(Uint) *text,
+			       Eterm t,
+			       int *constant)
+{
+    int i;
+    int heap_used = 0;
+
+    DMC_PUSH(*text, matchPushC);
+    DMC_PUSH(*text, NIL);
+    for (i = heap->used - 1; i >= 0; --i) { 
+	if (heap->data[i]) {
+	    DMC_PUSH(*text, matchPushV);
+	    DMC_PUSH(*text, i);
+	    DMC_PUSH(*text, matchConsB);
+	    heap_used += 2;
+	}
+    }
+    ++context->stack_used;
+    if ((context->stack_used + 1) > context->stack_need)
+	context->stack_need = (context->stack_used + 1);
+    context->eheap_need += heap_used;
+    *constant = 0;
+    return retOk;
+}
+
+static DMCRet dmc_const(DMCContext *context,
+		       DMCHeap *heap,
+		       DMC_STACK_TYPE(Uint) *text,
+		       Eterm t,
+		       int *constant)
+{
+    Eterm *p = tuple_val(t);
+    Uint a = arityval(*p);
+
+    if (a != 2) {
+	RETURN_TERM_ERROR("Special form 'const' called with more than one "
+			  "argument in %T.", t, context, *constant);
+    }
+    *constant = 1;
+    return retOk;
+}
+
+static DMCRet dmc_and(DMCContext *context,
+		      DMCHeap *heap,
+		      DMC_STACK_TYPE(Uint) *text,
+		      Eterm t,
+		      int *constant)
+{
+    Eterm *p = tuple_val(t);
+    Uint a = arityval(*p);
+    DMCRet ret;
+    int i;
+    int c;
+    
+    if (a < 2) {
+	RETURN_TERM_ERROR("Special form 'and' called without arguments "
+			  "in %T.", t, context, *constant);
+    }
+    *constant = 0;
+    for (i = a; i > 1; --i) {
+	if ((ret = dmc_expr(context, heap, text, p[i], &c)) != retOk)
+	    return ret;
+	if (c) 
+	    do_emit_constant(context, text, p[i]);
+    }
+    DMC_PUSH(*text, matchAnd);
+    DMC_PUSH(*text, (Uint) a - 1);
+    context->stack_used -= (a - 2);
+    return retOk;
+}
+
+static DMCRet dmc_or(DMCContext *context,
+		     DMCHeap *heap,
+		     DMC_STACK_TYPE(Uint) *text,
+		     Eterm t,
+		     int *constant)
+{
+    Eterm *p = tuple_val(t);
+    Uint a = arityval(*p);
+    DMCRet ret;
+    int i;
+    int c;
+    
+    if (a < 2) {
+	RETURN_TERM_ERROR("Special form 'or' called without arguments "
+			  "in %T.", t, context, *constant);
+    }
+    *constant = 0;
+    for (i = a; i > 1; --i) {
+	if ((ret = dmc_expr(context, heap, text, p[i], &c)) != retOk)
+	    return ret;
+	if (c) 
+	    do_emit_constant(context, text, p[i]);
+    }
+    DMC_PUSH(*text, matchOr);
+    DMC_PUSH(*text, (Uint) a - 1);
+    context->stack_used -= (a - 2);
+    return retOk;
+}
+
+
+static DMCRet dmc_andalso(DMCContext *context,
+			  DMCHeap *heap,
+			  DMC_STACK_TYPE(Uint) *text,
+			  Eterm t,
+			  int *constant)
+{
+    Eterm *p = tuple_val(t);
+    Uint a = arityval(*p);
+    DMCRet ret;
+    int i;
+    int c;
+    Uint lbl;
+    Uint lbl_next;
+    Uint lbl_val;
+
+    if (a < 2) {
+	RETURN_TERM_ERROR("Special form 'andalso' called without"
+			  " arguments "
+			  "in %T.", t, context, *constant);
+    }
+    *constant = 0;
+    lbl = 0;
+    for (i = 2; i <= a; ++i) {
+	if ((ret = dmc_expr(context, heap, text, p[i], &c)) != retOk)
+	    return ret;
+	if (c) 
+	    do_emit_constant(context, text, p[i]);
+	if (i == a) {
+	    DMC_PUSH(*text, matchJump);
+	} else {
+	    DMC_PUSH(*text, matchAndAlso);
+	}
+	DMC_PUSH(*text, lbl);
+	lbl = DMC_STACK_NUM(*text)-1;
+	--(context->stack_used);
+    }
+    DMC_PUSH(*text, matchPushC);
+    DMC_PUSH(*text, am_true);
+    lbl_val = DMC_STACK_NUM(*text);
+    while (lbl) {
+	lbl_next = DMC_PEEK(*text, lbl);
+	DMC_POKE(*text, lbl, lbl_val-lbl-1);
+	lbl = lbl_next;
+    }
+    if (++context->stack_used > context->stack_need)
+	context->stack_need = context->stack_used;
+    return retOk;
+}
+
+static DMCRet dmc_orelse(DMCContext *context,
+			 DMCHeap *heap,
+			 DMC_STACK_TYPE(Uint) *text,
+			 Eterm t,
+			 int *constant)
+{
+    Eterm *p = tuple_val(t);
+    Uint a = arityval(*p);
+    DMCRet ret;
+    int i;
+    int c;
+    Uint lbl;
+    Uint lbl_next;
+    Uint lbl_val;
+    
+    if (a < 2) {
+	RETURN_TERM_ERROR("Special form 'orelse' called without arguments "
+			  "in %T.", t, context, *constant);
+    }
+    *constant = 0;
+    lbl = 0;
+    for (i = 2; i <= a; ++i) {
+	if ((ret = dmc_expr(context, heap, text, p[i], &c)) != retOk)
+	    return ret;
+	if (c) 
+	    do_emit_constant(context, text, p[i]);
+	if (i == a) {
+	    DMC_PUSH(*text, matchJump);
+	} else {
+	    DMC_PUSH(*text, matchOrElse);
+	}
+	DMC_PUSH(*text, lbl);
+	lbl = DMC_STACK_NUM(*text)-1;
+	--(context->stack_used);
+    }
+    DMC_PUSH(*text, matchPushC);
+    DMC_PUSH(*text, am_false);
+    lbl_val = DMC_STACK_NUM(*text);
+    while (lbl) {
+	lbl_next = DMC_PEEK(*text, lbl);
+	DMC_POKE(*text, lbl, lbl_val-lbl-1);
+	lbl = lbl_next;
+    }
+    if (++context->stack_used > context->stack_need)
+	context->stack_need = context->stack_used;
+    return retOk;
+}
+
+static DMCRet dmc_message(DMCContext *context,
+			  DMCHeap *heap,
+			  DMC_STACK_TYPE(Uint) *text,
+			  Eterm t,
+			  int *constant)
+{
+    Eterm *p = tuple_val(t);
+    Uint a = arityval(*p);
+    DMCRet ret;
+    int c;
+    
+
+    if (!(context->cflags & DCOMP_TRACE)) {
+	RETURN_ERROR("Special form 'message' used in wrong dialect.",
+		     context, 
+		     *constant);
+    }
+    if (context->is_guard) {
+	RETURN_ERROR("Special form 'message' called in guard context.",
+		     context, 
+		     *constant);
+    }
+
+    if (a != 2) {
+	RETURN_TERM_ERROR("Special form 'message' called with wrong "
+			  "number of arguments in %T.", t, context, 
+			  *constant);
+    }
+    *constant = 0;
+    if ((ret = dmc_expr(context, heap, text, p[2], &c)) != retOk) {
+	return ret;
+    }
+    if (c) { 
+	do_emit_constant(context, text, p[2]);
+    }
+    DMC_PUSH(*text, matchReturn);
+    DMC_PUSH(*text, matchPushC);
+    DMC_PUSH(*text, am_true);
+    /* Push as much as we remove, stack_need is untouched */
+    return retOk;
+}
+
+static DMCRet dmc_self(DMCContext *context,
+		     DMCHeap *heap,
+		     DMC_STACK_TYPE(Uint) *text,
+		     Eterm t,
+		     int *constant)
+{
+    Eterm *p = tuple_val(t);
+    Uint a = arityval(*p);
+    
+    if (a != 1) {
+	RETURN_TERM_ERROR("Special form 'self' called with arguments "
+			  "in %T.", t, context, *constant);
+    }
+    *constant = 0;
+    DMC_PUSH(*text, matchSelf);
+    if (++context->stack_used > context->stack_need)
+	context->stack_need = context->stack_used;
+    return retOk;
+}
+
+static DMCRet dmc_return_trace(DMCContext *context,
+			       DMCHeap *heap,
+			       DMC_STACK_TYPE(Uint) *text,
+			       Eterm t,
+			       int *constant)
+{
+    Eterm *p = tuple_val(t);
+    Uint a = arityval(*p);
+    
+    if (!(context->cflags & DCOMP_TRACE)) {
+	RETURN_ERROR("Special form 'return_trace' used in wrong dialect.",
+		     context, 
+		     *constant);
+    }
+    if (context->is_guard) {
+	RETURN_ERROR("Special form 'return_trace' called in "
+		     "guard context.", context, *constant);
+    }
+
+    if (a != 1) {
+	RETURN_TERM_ERROR("Special form 'return_trace' called with "
+			  "arguments in %T.", t, context, *constant);
+    }
+    *constant = 0;
+    DMC_PUSH(*text, matchSetReturnTrace); /* Pushes 'true' on the stack */
+    if (++context->stack_used > context->stack_need)
+	context->stack_need = context->stack_used;
+    return retOk;
+}
+
+static DMCRet dmc_exception_trace(DMCContext *context,
+			       DMCHeap *heap,
+			       DMC_STACK_TYPE(Uint) *text,
+			       Eterm t,
+			       int *constant)
+{
+    Eterm *p = tuple_val(t);
+    Uint a = arityval(*p);
+    
+    if (!(context->cflags & DCOMP_TRACE)) {
+	RETURN_ERROR("Special form 'exception_trace' used in wrong dialect.",
+		     context, 
+		     *constant);
+    }
+    if (context->is_guard) {
+	RETURN_ERROR("Special form 'exception_trace' called in "
+		     "guard context.", context, *constant);
+    }
+
+    if (a != 1) {
+	RETURN_TERM_ERROR("Special form 'exception_trace' called with "
+			  "arguments in %T.", t, context, *constant);
+    }
+    *constant = 0;
+    DMC_PUSH(*text, matchSetExceptionTrace); /* Pushes 'true' on the stack */
+    if (++context->stack_used > context->stack_need)
+	context->stack_need = context->stack_used;
+    return retOk;
+}
+
+
+
+static DMCRet dmc_is_seq_trace(DMCContext *context,
+			       DMCHeap *heap,
+			       DMC_STACK_TYPE(Uint) *text,
+			       Eterm t,
+			       int *constant)
+{
+    Eterm *p = tuple_val(t);
+    Uint a = arityval(*p);
+    
+    if (!(context->cflags & DCOMP_TRACE)) {
+	RETURN_ERROR("Special form 'is_seq_trace' used in wrong dialect.",
+		     context, 
+		     *constant);
+    }
+    if (a != 1) {
+	RETURN_TERM_ERROR("Special form 'is_seq_trace' called with "
+			  "arguments in %T.", t, context, *constant);
+    }
+    *constant = 0;
+    DMC_PUSH(*text, matchIsSeqTrace); 
+    /* Pushes 'true' or 'false' on the stack */
+    if (++context->stack_used > context->stack_need)
+	context->stack_need = context->stack_used;
+    return retOk;
+}
+
+static DMCRet dmc_set_seq_token(DMCContext *context,
+				DMCHeap *heap,
+				DMC_STACK_TYPE(Uint) *text,
+				Eterm t,
+				int *constant)
+{
+    Eterm *p = tuple_val(t);
+    Uint a = arityval(*p);
+    DMCRet ret;
+    int c;
+    
+
+    if (!(context->cflags & DCOMP_TRACE)) {
+	RETURN_ERROR("Special form 'set_seq_token' used in wrong dialect.",
+		     context, 
+		     *constant);
+    }
+    if (context->is_guard) {
+	RETURN_ERROR("Special form 'set_seq_token' called in "
+		     "guard context.", context, *constant);
+    }
+
+    if (a != 3) {
+	RETURN_TERM_ERROR("Special form 'set_seq_token' called with wrong "
+			  "number of arguments in %T.", t, context, 
+			  *constant);
+    }
+    *constant = 0;
+    if ((ret = dmc_expr(context, heap, text, p[3], &c)) != retOk) {
+	return ret;
+    }
+    if (c) { 
+	do_emit_constant(context, text, p[3]);
+    }
+    if ((ret = dmc_expr(context, heap, text, p[2], &c)) != retOk) {
+	return ret;
+    }
+    if (c) { 
+	do_emit_constant(context, text, p[2]);
+    }
+    if (context->cflags & DCOMP_FAKE_DESTRUCTIVE) {
+	DMC_PUSH(*text, matchSetSeqTokenFake);
+    } else {
+	DMC_PUSH(*text, matchSetSeqToken);
+    }
+    --context->stack_used; /* Remove two and add one */
+    return retOk;
+}
+
+static DMCRet dmc_get_seq_token(DMCContext *context,
+				DMCHeap *heap,
+				DMC_STACK_TYPE(Uint) *text,
+				Eterm t,
+				int *constant)
+{
+    Eterm *p = tuple_val(t);
+    Uint a = arityval(*p);
+
+    if (!(context->cflags & DCOMP_TRACE)) {
+	RETURN_ERROR("Special form 'get_seq_token' used in wrong dialect.",
+		     context, 
+		     *constant);
+    }
+    if (context->is_guard) {
+	RETURN_ERROR("Special form 'get_seq_token' called in "
+		     "guard context.", context, *constant);
+    }
+    if (a != 1) {
+	RETURN_TERM_ERROR("Special form 'get_seq_token' called with "
+			  "arguments in %T.", t, context, 
+			  *constant);
+    }
+
+    *constant = 0;
+    DMC_PUSH(*text, matchGetSeqToken);
+    context->eheap_need += (6 /* A 5-tuple is built */
+			    + EXTERNAL_THING_HEAD_SIZE + 2 /* Sender can
+							      be an external
+							      pid */);
+    if (++context->stack_used > context->stack_need)
+ 	context->stack_need = context->stack_used;
+    return retOk;
+}
+
+
+
+static DMCRet dmc_display(DMCContext *context,
+			  DMCHeap *heap,
+			  DMC_STACK_TYPE(Uint) *text,
+			  Eterm t,
+			  int *constant)
+{
+    Eterm *p = tuple_val(t);
+    Uint a = arityval(*p);
+    DMCRet ret;
+    int c;
+    
+
+    if (!(context->cflags & DCOMP_TRACE)) {
+	RETURN_ERROR("Special form 'display' used in wrong dialect.",
+		     context, 
+		     *constant);
+    }
+    if (context->is_guard) {
+	RETURN_ERROR("Special form 'display' called in guard context.",
+		     context, 
+		     *constant);
+    }
+
+    if (a != 2) {
+	RETURN_TERM_ERROR("Special form 'display' called with wrong "
+			  "number of arguments in %T.", t, context, 
+			  *constant);
+    }
+    *constant = 0;
+    if ((ret = dmc_expr(context, heap, text, p[2], &c)) != retOk) {
+	return ret;
+    }
+    if (c) { 
+	do_emit_constant(context, text, p[2]);
+    }
+    DMC_PUSH(*text, matchDisplay);
+    /* Push as much as we remove, stack_need is untouched */
+    return retOk;
+}
+
+static DMCRet dmc_process_dump(DMCContext *context,
+			       DMCHeap *heap,
+			       DMC_STACK_TYPE(Uint) *text,
+			       Eterm t,
+			       int *constant)
+{
+    Eterm *p = tuple_val(t);
+    Uint a = arityval(*p);
+    
+    if (!(context->cflags & DCOMP_TRACE)) {
+	RETURN_ERROR("Special form 'process_dump' used in wrong dialect.",
+		     context, 
+		     *constant);
+    }
+    if (context->is_guard) {
+	RETURN_ERROR("Special form 'process_dump' called in "
+		     "guard context.", context, *constant);
+    }
+
+    if (a != 1) {
+	RETURN_TERM_ERROR("Special form 'process_dump' called with "
+			  "arguments in %T.", t, context, *constant);
+    }
+    *constant = 0;
+    DMC_PUSH(*text, matchProcessDump); /* Creates binary */
+    if (++context->stack_used > context->stack_need)
+	context->stack_need = context->stack_used;
+    return retOk;
+}
+
+static DMCRet dmc_enable_trace(DMCContext *context,
+			       DMCHeap *heap,
+			       DMC_STACK_TYPE(Uint) *text,
+			       Eterm t,
+			       int *constant)
+{
+    Eterm *p = tuple_val(t);
+    Uint a = arityval(*p);
+    DMCRet ret;
+    int c;
+    
+
+    if (!(context->cflags & DCOMP_TRACE)) {
+	RETURN_ERROR("Special form 'enable_trace' used in wrong dialect.",
+		     context, 
+		     *constant);
+    }
+    if (context->is_guard) {
+	RETURN_ERROR("Special form 'enable_trace' called in guard context.",
+		     context, 
+		     *constant);
+    }
+
+    switch (a) {
+    case 2:
+	*constant = 0;
+	if ((ret = dmc_expr(context, heap, text, p[2], &c)) != retOk) {
+	    return ret;
+	}
+	if (c) { 
+	    do_emit_constant(context, text, p[2]);
+	}
+	DMC_PUSH(*text, matchEnableTrace);
+	/* Push as much as we remove, stack_need is untouched */
+	break;
+    case 3:
+	*constant = 0;
+	if ((ret = dmc_expr(context, heap, text, p[3], &c)) != retOk) {
+	    return ret;
+	}
+	if (c) { 
+	    do_emit_constant(context, text, p[3]);
+	}
+	if ((ret = dmc_expr(context, heap, text, p[2], &c)) != retOk) {
+	    return ret;
+	}
+	if (c) { 
+	    do_emit_constant(context, text, p[2]);
+	}
+	DMC_PUSH(*text, matchEnableTrace2);
+	--context->stack_used; /* Remove two and add one */
+	break;
+    default:
+	RETURN_TERM_ERROR("Special form 'enable_trace' called with wrong "
+			  "number of arguments in %T.", t, context, 
+			  *constant);
+    }
+    return retOk;
+}
+
+static DMCRet dmc_disable_trace(DMCContext *context,
+				DMCHeap *heap,
+				DMC_STACK_TYPE(Uint) *text,
+				Eterm t,
+				int *constant)
+{
+    Eterm *p = tuple_val(t);
+    Uint a = arityval(*p);
+    DMCRet ret;
+    int c;
+    
+
+    if (!(context->cflags & DCOMP_TRACE)) {
+	RETURN_ERROR("Special form 'disable_trace' used in wrong dialect.",
+		     context, 
+		     *constant);
+    }
+    if (context->is_guard) {
+	RETURN_ERROR("Special form 'disable_trace' called in guard context.",
+		     context, 
+		     *constant);
+    }
+
+    switch (a) {
+    case 2:
+	*constant = 0;
+	if ((ret = dmc_expr(context, heap, text, p[2], &c)) != retOk) {
+	    return ret;
+	}
+	if (c) { 
+	    do_emit_constant(context, text, p[2]);
+	}
+	DMC_PUSH(*text, matchDisableTrace);
+	/* Push as much as we remove, stack_need is untouched */
+	break;
+    case 3:
+	*constant = 0;
+	if ((ret = dmc_expr(context, heap, text, p[3], &c)) != retOk) {
+	    return ret;
+	}
+	if (c) { 
+	    do_emit_constant(context, text, p[3]);
+	}
+	if ((ret = dmc_expr(context, heap, text, p[2], &c)) != retOk) {
+	    return ret;
+	}
+	if (c) { 
+	    do_emit_constant(context, text, p[2]);
+	}
+	DMC_PUSH(*text, matchDisableTrace2);
+	--context->stack_used; /* Remove two and add one */
+	break;
+    default:
+	RETURN_TERM_ERROR("Special form 'disable_trace' called with wrong "
+			  "number of arguments in %T.", t, context, 
+			  *constant);
+    }
+    return retOk;
+}
+
+static DMCRet dmc_trace(DMCContext *context,
+			DMCHeap *heap,
+			DMC_STACK_TYPE(Uint) *text,
+			Eterm t,
+			int *constant)
+{
+    Eterm *p = tuple_val(t);
+    Uint a = arityval(*p);
+    DMCRet ret;
+    int c;
+    
+
+    if (!(context->cflags & DCOMP_TRACE)) {
+	RETURN_ERROR("Special form 'trace' used in wrong dialect.",
+		     context, 
+		     *constant);
+    }
+    if (context->is_guard) {
+	RETURN_ERROR("Special form 'trace' called in guard context.",
+		     context, 
+		     *constant);
+    }
+
+    switch (a) {
+    case 3:
+	*constant = 0;
+	if ((ret = dmc_expr(context, heap, text, p[3], &c)) != retOk) {
+	    return ret;
+	}
+	if (c) { 
+	    do_emit_constant(context, text, p[3]);
+	}
+	if ((ret = dmc_expr(context, heap, text, p[2], &c)) != retOk) {
+	    return ret;
+	}
+	if (c) { 
+	    do_emit_constant(context, text, p[2]);
+	}
+	DMC_PUSH(*text, matchTrace2);
+	--context->stack_used; /* Remove two and add one */
+	break;
+    case 4:
+	*constant = 0;
+	if ((ret = dmc_expr(context, heap, text, p[4], &c)) != retOk) {
+	    return ret;
+	}
+	if (c) { 
+	    do_emit_constant(context, text, p[4]);
+	}
+	if ((ret = dmc_expr(context, heap, text, p[3], &c)) != retOk) {
+	    return ret;
+	}
+	if (c) { 
+	    do_emit_constant(context, text, p[3]);
+	}
+	if ((ret = dmc_expr(context, heap, text, p[2], &c)) != retOk) {
+	    return ret;
+	}
+	if (c) { 
+	    do_emit_constant(context, text, p[2]);
+	}
+	DMC_PUSH(*text, matchTrace3);
+	context->stack_used -= 2; /* Remove three and add one */
+	break;
+    default:
+	RETURN_TERM_ERROR("Special form 'trace' called with wrong "
+			  "number of arguments in %T.", t, context, 
+			  *constant);
+    }
+    return retOk;
+}
+
+
+
+static DMCRet dmc_caller(DMCContext *context,
+ 			 DMCHeap *heap,
+ 			 DMC_STACK_TYPE(Uint) *text,
+ 			 Eterm t,
+ 			 int *constant)
+{
+    Eterm *p = tuple_val(t);
+    Uint a = arityval(*p);
+     
+    if (!(context->cflags & DCOMP_TRACE)) {
+	RETURN_ERROR("Special form 'caller' used in wrong dialect.",
+		     context, 
+		     *constant);
+    }
+    if (context->is_guard) {
+ 	RETURN_ERROR("Special form 'caller' called in "
+ 		     "guard context.", context, *constant);
+    }
+  
+    if (a != 1) {
+ 	RETURN_TERM_ERROR("Special form 'caller' called with "
+ 			  "arguments in %T.", t, context, *constant);
+    }
+    *constant = 0;
+    DMC_PUSH(*text, matchCaller); /* Creates binary */
+    context->eheap_need += 4;     /* A 3-tuple is built */
+    if (++context->stack_used > context->stack_need)
+ 	context->stack_need = context->stack_used;
+    return retOk;
+}
+
+
+  
+static DMCRet dmc_silent(DMCContext *context,
+ 			 DMCHeap *heap,
+ 			 DMC_STACK_TYPE(Uint) *text,
+ 			 Eterm t,
+ 			 int *constant)
+{
+    Eterm *p = tuple_val(t);
+    Uint a = arityval(*p);
+    DMCRet ret;
+    int c;
+     
+    if (!(context->cflags & DCOMP_TRACE)) {
+	RETURN_ERROR("Special form 'silent' used in wrong dialect.",
+		     context, 
+		     *constant);
+    }
+    if (context->is_guard) {
+ 	RETURN_ERROR("Special form 'silent' called in "
+ 		     "guard context.", context, *constant);
+    }
+  
+    if (a != 2) {
+	RETURN_TERM_ERROR("Special form 'silent' called with wrong "
+			  "number of arguments in %T.", t, context, 
+			  *constant);
+    }
+    *constant = 0;
+    if ((ret = dmc_expr(context, heap, text, p[2], &c)) != retOk) {
+	return ret;
+    }
+    if (c) { 
+	do_emit_constant(context, text, p[2]);
+    }
+    DMC_PUSH(*text, matchSilent);
+    DMC_PUSH(*text, matchPushC);
+    DMC_PUSH(*text, am_true);
+    /* Push as much as we remove, stack_need is untouched */
+    return retOk;
+}
+  
+
+
+static DMCRet dmc_fun(DMCContext *context,
+		       DMCHeap *heap,
+		       DMC_STACK_TYPE(Uint) *text,
+		       Eterm t,
+		       int *constant)
+{
+    Eterm *p = tuple_val(t);
+    Uint a = arityval(*p);
+    int c;
+    int i;
+    DMCRet ret;
+    DMCGuardBif *b;
+ 
+    /* Special forms. */
+    switch (p[1]) {
+    case am_const:
+	return dmc_const(context, heap, text, t, constant);
+    case am_and:
+	return dmc_and(context, heap, text, t, constant);
+    case am_or:
+	return dmc_or(context, heap, text, t, constant);
+    case am_andalso:
+    case am_andthen:
+	return dmc_andalso(context, heap, text, t, constant);
+    case am_orelse:
+	return dmc_orelse(context, heap, text, t, constant);
+    case am_self:
+	return dmc_self(context, heap, text, t, constant);
+    case am_message:
+	return dmc_message(context, heap, text, t, constant);
+    case am_is_seq_trace:
+	return dmc_is_seq_trace(context, heap, text, t, constant);
+    case am_set_seq_token:
+	return dmc_set_seq_token(context, heap, text, t, constant);
+    case am_get_seq_token:
+	return dmc_get_seq_token(context, heap, text, t, constant);
+    case am_return_trace:
+	return dmc_return_trace(context, heap, text, t, constant);
+    case am_exception_trace:
+	return dmc_exception_trace(context, heap, text, t, constant);
+    case am_display:
+	return dmc_display(context, heap, text, t, constant);
+    case am_process_dump:
+	return dmc_process_dump(context, heap, text, t, constant);
+    case am_enable_trace:
+	return dmc_enable_trace(context, heap, text, t, constant);
+    case am_disable_trace:
+	return dmc_disable_trace(context, heap, text, t, constant);
+    case am_trace:
+	return dmc_trace(context, heap, text, t, constant);
+    case am_caller:
+ 	return dmc_caller(context, heap, text, t, constant);
+    case am_silent:
+ 	return dmc_silent(context, heap, text, t, constant);
+    case am_set_tcw:
+	if (context->cflags & DCOMP_FAKE_DESTRUCTIVE) {
+	    b = dmc_lookup_bif(am_set_tcw_fake, ((int) a) - 1);
+	} else {
+	    b = dmc_lookup_bif(p[1], ((int) a) - 1);
+	}
+	break;
+    default:
+	b = dmc_lookup_bif(p[1], ((int) a) - 1);
+    }
+
+
+    if (b == NULL) {
+	if (context->err_info != NULL) {
+	    /* Ugly, should define a better RETURN_TERM_ERROR interface... */
+	    char buff[100];
+	    sprintf(buff, "Function %%T/%d does_not_exist.", (int)a - 1);
+	    RETURN_TERM_ERROR(buff, p[1], context, *constant);
+	} else {
+	    return retFail;
+	}
+    } 
+    ASSERT(b->arity == ((int) a) - 1);
+    if (! (b->flags & 
+	   (1 << 
+	    ((context->cflags & DCOMP_DIALECT_MASK) + 
+	      (context->is_guard ? DBIF_GUARD : DBIF_BODY))))) {
+	/* Body clause used in wrong context. */
+	if (context->err_info != NULL) {
+	    /* Ugly, should define a better RETURN_TERM_ERROR interface... */
+	    char buff[100];
+	    sprintf(buff, 
+		    "Function %%T/%d cannot be called in this context.",
+		    (int)a - 1);
+	    RETURN_TERM_ERROR(buff, p[1], context, *constant);
+	} else {
+	    return retFail;
+	}
+    }	
+
+    *constant = 0;
+
+    for (i = a; i > 1; --i) {
+	if ((ret = dmc_expr(context, heap, text, p[i], &c)) != retOk)
+	    return ret;
+	if (c) 
+	    do_emit_constant(context, text, p[i]);
+    }
+    switch (b->arity) {
+    case 0:
+	DMC_PUSH(*text, matchCall0);
+	break;
+    case 1:
+	DMC_PUSH(*text, matchCall1);
+	break;
+    case 2:
+	DMC_PUSH(*text, matchCall2);
+	break;
+    case 3:
+	DMC_PUSH(*text, matchCall3);
+	break;
+    default:
+	erl_exit(1,"ets:match() internal error, "
+		 "guard with more than 3 arguments.");
+    }
+    DMC_PUSH(*text, (Uint) b->biff);
+    context->stack_used -= (((int) a) - 2);
+    if (context->stack_used > context->stack_need)
+ 	context->stack_need = context->stack_used;
+    return retOk;
+}
+
+static DMCRet dmc_expr(DMCContext *context,
+		       DMCHeap *heap,
+		       DMC_STACK_TYPE(Uint) *text,
+		       Eterm t,
+		       int *constant)
+{
+    DMCRet ret;
+    Eterm tmp;
+    Eterm *p;
+
+
+    switch (t & _TAG_PRIMARY_MASK) {
+    case TAG_PRIMARY_LIST:
+	if ((ret = dmc_list(context, heap, text, t, constant)) != retOk)
+	    return ret;
+	break;
+    case TAG_PRIMARY_BOXED:
+	if (!BOXED_IS_TUPLE(t)) {
+	    goto simple_term;
+	}
+	p = tuple_val(t);
+#ifdef HARDDEBUG
+	erts_fprintf(stderr,"%d %d %d %d\n",arityval(*p),is_tuple(tmp = p[1]),
+		     is_atom(p[1]),db_is_variable(p[1]));
+#endif
+	if (arityval(*p) == 1 && is_tuple(tmp = p[1])) {
+	    if ((ret = dmc_tuple(context, heap, text, tmp, constant)) != retOk)
+		return ret;
+	} else if (arityval(*p) >= 1 && is_atom(p[1]) && 
+		   !(db_is_variable(p[1]) >= 0)) {
+	    if ((ret = dmc_fun(context, heap, text, t, constant)) != retOk)
+		return ret;
+	} else
+	    RETURN_TERM_ERROR("%T is neither a function call, nor a tuple "
+			      "(tuples are written {{ ... }}).", t,
+			      context, *constant);
+	break;
+    case TAG_PRIMARY_IMMED1:
+	if (db_is_variable(t) >= 0) {
+	    if ((ret = dmc_variable(context, heap, text, t, constant)) 
+		!= retOk)
+		return ret;
+	    break;
+	} else if (t == am_DollarUnderscore) {
+	    if ((ret = dmc_whole_expression(context, heap, text, t, constant)) 
+		!= retOk)
+		return ret;
+	    break;
+	} else if (t == am_DollarDollar) {
+	    if ((ret = dmc_all_bindings(context, heap, text, t, constant)) 
+		!= retOk)
+		return ret;
+	    break;
+	}	    
+	/* Fall through */
+    default:
+    simple_term:
+	*constant = 1;
+    }
+    return retOk;
+}
+
+    
+static DMCRet compile_guard_expr(DMCContext *context,
+				 DMCHeap *heap,
+				 DMC_STACK_TYPE(Uint) *text,
+				 Eterm l)
+{
+    DMCRet ret;
+    int constant;
+    Eterm t;
+
+    if (l != NIL) {
+	if (!is_list(l))
+	    RETURN_ERROR("Match expression is not a list.", 
+			 context, constant);
+	if (!(context->is_guard)) {
+	    DMC_PUSH(*text, matchCatch);
+	}
+	while (is_list(l)) {
+	    constant = 0;
+	    t = CAR(list_val(l));
+	    if ((ret = dmc_expr(context, heap, text, t, &constant)) !=
+		retOk)
+		return ret;
+	    if (constant) {
+		do_emit_constant(context, text, t);
+	    }
+	    l = CDR(list_val(l));
+	    if (context->is_guard) {
+		DMC_PUSH(*text,matchTrue);
+	    } else {
+		DMC_PUSH(*text,matchWaste);
+	    }
+	    --context->stack_used;
+	}
+	if (l != NIL) 
+	    RETURN_ERROR("Match expression is not a proper list.",
+			 context, constant);
+	if (!(context->is_guard) && (context->cflags & DCOMP_TABLE)) {
+	    ASSERT(matchWaste == DMC_TOP(*text));
+	    (void) DMC_POP(*text);
+	    DMC_PUSH(*text, matchReturn); /* Same impact on stack as 
+					     matchWaste */
+	}
+    }
+    return retOk;
+}
+
+
+
+
+/*
+** Match compilation utility code
+*/
+
+/*
+** Handling of bif's in match guard expressions
+*/
+
+static DMCGuardBif *dmc_lookup_bif(Eterm t, int arity)
+{
+    /*
+    ** Place for optimization, bsearch is slower than inlining it...
+    */
+    DMCGuardBif node = {0,NULL,0};
+    node.name = t;
+    node.arity = arity;
+    return bsearch(&node, 
+		   guard_tab, 
+		   sizeof(guard_tab) / sizeof(DMCGuardBif),
+		   sizeof(DMCGuardBif), 
+		   (int (*)(const void *, const void *)) &cmp_guard_bif); 
+}
+
+#ifdef DMC_DEBUG
+static Eterm dmc_lookup_bif_reversed(void *f)
+{
+    int i;
+    for (i = 0; i < (sizeof(guard_tab) / sizeof(DMCGuardBif)); ++i)
+	if (f == guard_tab[i].biff)
+	    return guard_tab[i].name;
+    return am_undefined;
+}
+#endif
+
+/* For sorting. */
+static int cmp_uint(void *a, void *b) 
+{
+    if (*((unsigned *)a) <  *((unsigned *)b))
+	return -1;
+    else
+	return (*((unsigned *)a) >  *((unsigned *)b));
+}
+
+static int cmp_guard_bif(void *a, void *b)
+{
+    int ret;
+    if (( ret = ((int) atom_val(((DMCGuardBif *) a)->name)) -
+	 ((int) atom_val(((DMCGuardBif *) b)->name)) ) == 0) {
+	ret = ((DMCGuardBif *) a)->arity - ((DMCGuardBif *) b)->arity;
+    }
+    return ret;
+}
+
+/*
+** Compact the variables in a match expression i e make {$1, $100, $1000} 
+** become {$0,$1,$2}.
+*/
+static int match_compact(ErlHeapFragment *expr, DMCErrInfo *err_info)
+{
+    int i, j, a, n, x;
+    DMC_STACK_TYPE(unsigned) heap;
+    Eterm *p;
+    char buff[25] = "$"; /* large enough for 64 bit to */
+    int ret;
+
+    DMC_INIT_STACK(heap);
+
+    p = expr->mem;
+    i = expr->size;
+    while (i--) {
+	if (is_thing(*p)) {
+	    a = thing_arityval(*p);
+	    ASSERT(a <= i);
+	    i -= a;
+	    p += a;
+	} else if (is_atom(*p) && (n = db_is_variable(*p)) >= 0) {
+	    x = DMC_STACK_NUM(heap);
+	    for (j = 0; j < x && DMC_PEEK(heap,j) != n; ++j) 
+		;
+	    
+	    if (j == x)
+		DMC_PUSH(heap,n);
+	}
+	++p;
+    }
+    qsort(DMC_STACK_DATA(heap), DMC_STACK_NUM(heap), sizeof(unsigned), 
+	  (int (*)(const void *, const void *)) &cmp_uint);
+
+    if (err_info != NULL) { /* lint needs a translation table */
+	err_info->var_trans = erts_alloc(ERTS_ALC_T_DB_TRANS_TAB,
+					 sizeof(unsigned)*DMC_STACK_NUM(heap));
+	sys_memcpy(err_info->var_trans, DMC_STACK_DATA(heap),
+		   DMC_STACK_NUM(heap) * sizeof(unsigned));
+	err_info->num_trans = DMC_STACK_NUM(heap);
+    }
+
+    p = expr->mem;
+    i = expr->size;
+    while (i--) {
+	if (is_thing(*p)) {
+	    a = thing_arityval(*p);
+	    i -= a;
+	    p += a;
+	} else if (is_atom(*p) && (n = db_is_variable(*p)) >= 0) {
+	    x = DMC_STACK_NUM(heap);
+#ifdef HARDDEBUG
+	    erts_fprintf(stderr, "%T");
+#endif
+	    for (j = 0; j < x && DMC_PEEK(heap,j) != n; ++j) 
+		;
+	    ASSERT(j < x);
+	    sprintf(buff+1,"%u", (unsigned) j);
+	    /* Yes, writing directly into terms, they ARE off heap */
+	    *p = am_atom_put(buff, strlen(buff));
+	}
+	++p;
+    }
+    ret = DMC_STACK_NUM(heap);
+    DMC_FREE(heap);
+    return ret;
+}
+
+/*
+** Simple size object that takes care of function calls and constant tuples
+*/
+static Uint my_size_object(Eterm t) 
+{
+    Uint sum = 0;
+    Eterm tmp;
+    Eterm *p;
+    switch (t & _TAG_PRIMARY_MASK) {
+    case TAG_PRIMARY_LIST:
+	sum += 2 + my_size_object(CAR(list_val(t))) + 
+	    my_size_object(CDR(list_val(t)));
+	break;
+    case TAG_PRIMARY_BOXED:
+	if ((((*boxed_val(t)) & 
+	      _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) !=
+	    (_TAG_HEADER_ARITYVAL >> _TAG_PRIMARY_SIZE)) {
+	    goto simple_term;
+	}
+
+	if (arityval(*tuple_val(t)) == 1 && is_tuple(tmp = tuple_val(t)[1])) {
+	    Uint i,n;
+	    p = tuple_val(tmp);
+	    n = arityval(p[0]);
+	    sum += 1 + n;
+	    for (i = 1; i <= n; ++i)
+		sum += my_size_object(p[i]);
+	} else if (arityval(*tuple_val(t)) == 2 &&
+		   is_atom(tmp = tuple_val(t)[1]) &&
+		   tmp == am_const) {
+	    sum += size_object(tuple_val(t)[2]);
+	} else {
+	    erl_exit(1,"Internal error, sizing unrecognized object in "
+		     "(d)ets:match compilation.");
+	}
+	break;
+    default:
+    simple_term:
+	sum += size_object(t);
+	break;
+    }
+    return sum;
+}
+
+static Eterm my_copy_struct(Eterm t, Eterm **hp, ErlOffHeap* off_heap)
+{
+    Eterm ret = NIL, a, b;
+    Eterm *p;
+    Uint sz;
+    switch (t & _TAG_PRIMARY_MASK) {
+    case TAG_PRIMARY_LIST:
+	a = my_copy_struct(CAR(list_val(t)), hp, off_heap);
+	b = my_copy_struct(CDR(list_val(t)), hp, off_heap);
+	ret = CONS(*hp, a, b);
+	*hp += 2;
+	break;
+    case TAG_PRIMARY_BOXED:
+	if (BOXED_IS_TUPLE(t)) {
+	    if (arityval(*tuple_val(t)) == 1 && 
+		is_tuple(a = tuple_val(t)[1])) {
+		Uint i,n;
+		Eterm *savep = *hp;
+		ret = make_tuple(savep);
+		p = tuple_val(a);
+		n = arityval(p[0]);
+		*hp += n + 1;
+		*savep++ = make_arityval(n);
+		for(i = 1; i <= n; ++i) 
+		    *savep++ = my_copy_struct(p[i], hp, off_heap);
+	    } else if (arityval(*tuple_val(t)) == 2 && 
+		       is_atom(a = tuple_val(t)[1]) &&
+		       a == am_const) {
+		/* A {const, XXX} expression */
+		b = tuple_val(t)[2];
+		sz = size_object(b);
+		ret = copy_struct(b,sz,hp,off_heap);
+	    } else {
+		erl_exit(1, "Trying to constant-copy non constant expression "
+			 "0x%08x in (d)ets:match compilation.", (unsigned long) t);
+	    }
+	} else {
+	    sz = size_object(t);
+	    ret = copy_struct(t,sz,hp,off_heap);
+	}
+	break;
+    default:
+	ret = t;
+    }
+    return ret;
+}
+
+/*
+** Compiled match bif interface
+*/
+/*
+** erlang:match_spec_test(MatchAgainst, MatchSpec, Type) -> 
+**   {ok, Return, Flags, Errors} | {error, Errors}
+** MatchAgainst -> if Type == trace: list() else tuple()
+** MatchSpec -> MatchSpec with body corresponding to Type
+** Type -> trace | table (only trace implemented in R5C)
+** Return -> if Type == trace TraceReturn else {BodyReturn, VariableBindings}
+** TraceReturn -> {true | false | term()} 
+** BodyReturn -> term()
+** VariableBindings -> [term(), ...] 
+** Errors -> [OneError, ...]
+** OneError -> {error, string()} | {warning, string()}
+** Flags -> [Flag, ...]
+** Flag -> return_trace (currently only flag)
+*/
+BIF_RETTYPE match_spec_test_3(BIF_ALIST_3)
+{
+    Eterm res;
+#ifdef DMC_DEBUG
+    if (BIF_ARG_3 == am_atom_put("dis",3)) {
+	test_disassemble_next = 1;
+	BIF_RET(am_true);
+    } else
+#endif
+    if (BIF_ARG_3 == am_trace) {
+	res = match_spec_test(BIF_P, BIF_ARG_1, BIF_ARG_2, 1);
+	if (is_value(res)) {
+	    BIF_RET(res);
+	}
+    } else if (BIF_ARG_3 == am_table) {
+	res = match_spec_test(BIF_P, BIF_ARG_1, BIF_ARG_2, 0);
+	if (is_value(res)) {
+	    BIF_RET(res);
+	}
+    } 
+    BIF_ERROR(BIF_P, BADARG);
+}
+
+static Eterm match_spec_test(Process *p, Eterm against, Eterm spec, int trace)
+{
+    Eterm lint_res;
+    Binary *mps;
+    Eterm res;
+    Eterm ret;
+    Eterm flg;
+    Eterm *hp;
+    Eterm *arr;
+    int n;
+    Eterm l;
+    Uint32 ret_flags;
+    Uint sz;
+    Eterm *save_cp;
+
+    if (trace && !(is_list(against) || against == NIL)) {
+	return THE_NON_VALUE;
+    }
+    if (trace) {
+	lint_res = db_match_set_lint(p, spec, DCOMP_TRACE | DCOMP_FAKE_DESTRUCTIVE);
+	mps = db_match_set_compile(p, spec, DCOMP_TRACE | DCOMP_FAKE_DESTRUCTIVE);
+    } else {
+	lint_res = db_match_set_lint(p, spec, DCOMP_TABLE | DCOMP_FAKE_DESTRUCTIVE);
+	mps = db_match_set_compile(p, spec, DCOMP_TABLE | DCOMP_FAKE_DESTRUCTIVE);
+    }
+    
+    if (mps == NULL) {
+	hp = HAlloc(p,3);
+	ret = TUPLE2(hp, am_error, lint_res);
+    } else {
+#ifdef DMC_DEBUG
+	if (test_disassemble_next) {
+	    test_disassemble_next = 0;
+	    db_match_dis(mps);
+	}
+#endif /* DMC_DEBUG */
+	l = against;
+	n = 0;
+	while (is_list(l)) {
+	    ++n;
+	    l = CDR(list_val(l));
+	}
+	if (trace) {
+	    if (n)
+		arr = erts_alloc(ERTS_ALC_T_DB_TMP, sizeof(Eterm) * n);
+	    else 
+		arr = NULL;
+	    l = against;
+	    n = 0;
+	    while (is_list(l)) {
+		arr[n] = CAR(list_val(l));
+		++n;
+		l = CDR(list_val(l));
+	    }
+	} else {
+	    n = 0;
+	    arr = (Eterm *) against;
+	}
+	
+	/* We are in the context of a BIF, 
+	   {caller} should return 'undefined' */
+	save_cp = p->cp;
+	p->cp = NULL;
+	res = erts_match_set_run(p, mps, arr, n, &ret_flags);
+	p->cp = save_cp;
+	if (is_non_value(res)) {
+	    res = am_false;
+	}
+	sz = size_object(res);
+	if (ret_flags & MATCH_SET_EXCEPTION_TRACE) sz += 2;
+	if (ret_flags & MATCH_SET_RETURN_TRACE) sz += 2;
+	hp = HAlloc(p, 5 + sz);
+	res = copy_struct(res, sz, &hp, &MSO(p));
+	flg = NIL;
+	if (ret_flags & MATCH_SET_EXCEPTION_TRACE) {
+	    flg = CONS(hp, am_exception_trace, flg);
+	    hp += 2;
+	}
+	if (ret_flags & MATCH_SET_RETURN_TRACE) {
+	    flg = CONS(hp, am_return_trace, flg);
+	    hp += 2;
+	}
+	if (trace && arr != NULL) {
+	    erts_free(ERTS_ALC_T_DB_TMP, arr);
+	}
+	erts_bin_free(mps);
+	ret = TUPLE4(hp, am_atom_put("ok",2), res, flg, lint_res);
+    }
+    return ret;
+}
+
+static Eterm seq_trace_fake(Process *p, Eterm arg1)
+{
+    Eterm result = seq_trace_info_1(p,arg1);
+    if (is_tuple(result) && *tuple_val(result) == 2) {
+	return (tuple_val(result))[2];
+    }
+    return result;
+}
+    
+#ifdef DMC_DEBUG
+/*
+** Disassemble match program
+*/
+static void db_match_dis(Binary *bp)
+{
+    MatchProg *prog = Binary2MatchProg(bp);
+    Uint *t = prog->text;
+    Uint n;
+    Eterm p;
+    int first;
+    ErlHeapFragment *tmp;
+
+    while (t < prog->prog_end) {
+	switch (*t) {
+	case matchTryMeElse:
+	    ++t;
+	    n = *t;
+	    ++t;
+	    erts_printf("TryMeElse\t%bpu\n", n);
+	    break;
+	case matchArray:
+	    ++t;
+	    n = *t;
+	    ++t;
+	    erts_printf("Array\t%bpu\n", n);
+	    break;
+	case matchArrayBind:
+	    ++t;
+	    n = *t;
+	    ++t;
+	    erts_printf("ArrayBind\t%bpu\n", n);
+	    break;
+	case matchTuple:
+	    ++t;
+	    n = *t;
+	    ++t;
+	    erts_printf("Tuple\t%bpu\n", n);
+	    break;
+	case matchPushT:
+	    ++t;
+	    n = *t;
+	    ++t;
+	    erts_printf("PushT\t%bpu\n", n);
+	    break;
+	case matchPushL:
+	    ++t;
+	    erts_printf("PushL\n");
+	    break;
+	case matchPop:
+	    ++t;
+	    erts_printf("Pop\n");
+	    break;
+	case matchBind:
+	    ++t;
+	    n = *t;
+	    ++t;
+	    erts_printf("Bind\t%bpu\n", n);
+	    break;
+	case matchCmp:
+	    ++t;
+	    n = *t;
+	    ++t;
+	    erts_printf("Cmp\t%bpu\n", n);
+	    break;
+	case matchEqBin:
+	    ++t;
+	    p = (Eterm) *t;
+	    ++t;
+	    erts_printf("EqBin\t%p (%T)\n", t, p);
+	    break;
+	case matchEqRef:
+	    ++t;
+	    n = thing_arityval(*t);
+	    ++t;
+	    erts_printf("EqRef\t(%d) {", (int) n);
+	    first = 1;
+	    while (n--) {
+		if (first)
+		    first = 0;
+		else
+		    erts_printf(", ");
+#ifdef ARCH_64
+		erts_printf("0x%016bpx", *t);
+#else
+		erts_printf("0x%08bpx", *t);
+#endif
+		++t;
+	    }
+	    erts_printf("}\n");
+	    break;
+	case matchEqBig:
+	    ++t;
+	    n = thing_arityval(*t);
+	    ++t;
+	    erts_printf("EqBig\t(%d) {", (int) n);
+	    first = 1;
+	    while (n--) {
+		if (first)
+		    first = 0;
+		else
+		    erts_printf(", ");
+#ifdef ARCH_64
+		erts_printf("0x%016bpx", *t);
+#else
+		erts_printf("0x%08bpx", *t);
+#endif
+		++t;
+	    }
+	    erts_printf("}\n");
+	    break;
+	case matchEqFloat:
+	    ++t;
+	    {
+		double num;
+		memcpy(&num,t, 2 * sizeof(*t));
+		t += 2;
+		erts_printf("EqFloat\t%f\n", num);
+	    }
+	    break;
+	case matchEq:
+	    ++t;
+	    p = (Eterm) *t;
+	    ++t;
+	    erts_printf("Eq  \t%T\n", p);
+	    break;
+	case matchList:
+	    ++t;
+	    erts_printf("List\n");
+	    break;
+	case matchHalt:
+	    ++t;
+	    erts_printf("Halt\n");
+	    break;
+	case matchSkip:
+	    ++t;
+	    erts_printf("Skip\n");
+	    break;
+	case matchPushC:
+	    ++t;
+	    p = (Eterm) *t;
+	    ++t;
+	    erts_printf("PushC\t%T\n", p);
+	    break;
+	case matchConsA:
+	    ++t;
+	    erts_printf("ConsA\n");
+	    break;
+	case matchConsB:
+	    ++t;
+	    erts_printf("ConsB\n");
+	    break;
+	case matchMkTuple:
+	    ++t;
+	    n = *t;
+	    ++t;
+	    erts_printf("MkTuple\t%bpu\n", n);
+	    break;
+	case matchOr:
+	    ++t;
+	    n = *t;
+	    ++t;
+	    erts_printf("Or\t%bpu\n", n);
+	    break;
+	case matchAnd:
+	    ++t;
+	    n = *t;
+	    ++t;
+	    erts_printf("And\t%bpu\n", n);
+	    break;
+	case matchOrElse:
+	    ++t;
+	    n = *t;
+	    ++t;
+	    erts_printf("OrElse\t%bpu\n", n);
+	    break;
+	case matchAndAlso:
+	    ++t;
+	    n = *t;
+	    ++t;
+	    erts_printf("AndAlso\t%bpu\n", n);
+	    break;
+	case matchCall0:
+	    ++t;
+	    p = dmc_lookup_bif_reversed((void *) *t);
+	    ++t;
+	    erts_printf("Call0\t%T\n", p);
+	    break;
+	case matchCall1:
+	    ++t;
+	    p = dmc_lookup_bif_reversed((void *) *t);
+	    ++t;
+	    erts_printf("Call1\t%T\n", p);
+	    break;
+	case matchCall2:
+	    ++t;
+	    p = dmc_lookup_bif_reversed((void *) *t);
+	    ++t;
+	    erts_printf("Call2\t%T\n", p);
+	    break;
+	case matchCall3:
+	    ++t;
+	    p = dmc_lookup_bif_reversed((void *) *t);
+	    ++t;
+	    erts_printf("Call3\t%T\n", p);
+	    break;
+	case matchPushV:
+	    ++t;
+	    n = (Uint) *t;
+	    ++t;
+	    erts_printf("PushV\t%bpu\n", n);
+	    break;
+	case matchTrue:
+	    ++t;
+	    erts_printf("True\n");
+	    break;
+	case matchPushExpr:
+	    ++t;
+	    erts_printf("PushExpr\n");
+	    break;
+	case matchPushArrayAsList:
+	    ++t;
+	    erts_printf("PushArrayAsList\n");
+	    break;
+	case matchPushArrayAsListU:
+	    ++t;
+	    erts_printf("PushArrayAsListU\n");
+	    break;
+	case matchSelf:
+	    ++t;
+	    erts_printf("Self\n");
+	    break;
+	case matchWaste:
+	    ++t;
+	    erts_printf("Waste\n");
+	    break;
+	case matchReturn:
+	    ++t;
+	    erts_printf("Return\n");
+	    break;
+	case matchProcessDump:
+	    ++t;
+	    erts_printf("ProcessDump\n");
+	    break;
+	case matchDisplay:
+	    ++t;
+	    erts_printf("Display\n");
+	    break;
+	case matchIsSeqTrace:
+	    ++t;
+	    erts_printf("IsSeqTrace\n");
+	    break;
+	case matchSetSeqToken:
+	    ++t;
+	    erts_printf("SetSeqToken\n");
+	    break;
+	case matchSetSeqTokenFake:
+	    ++t;
+	    erts_printf("SetSeqTokenFake\n");
+	    break;
+	case matchGetSeqToken:
+	    ++t;
+	    erts_printf("GetSeqToken\n");
+	    break;
+	case matchSetReturnTrace:
+	    ++t;
+	    erts_printf("SetReturnTrace\n");
+	    break;
+	case matchSetExceptionTrace:
+	    ++t;
+	    erts_printf("SetReturnTrace\n");
+	    break;
+	case matchCatch:
+	    ++t;
+	    erts_printf("Catch\n");
+	    break;
+	case matchEnableTrace:
+	    ++t;
+	    erts_printf("EnableTrace\n");
+	    break;
+	case matchDisableTrace:
+	    ++t;
+	    erts_printf("DisableTrace\n");
+	    break;
+	case matchEnableTrace2:
+	    ++t;
+	    erts_printf("EnableTrace2\n");
+	    break;
+	case matchDisableTrace2:
+	    ++t;
+	    erts_printf("DisableTrace2\n");
+	    break;
+	case matchTrace2:
+	    ++t;
+	    erts_printf("Trace2\n");
+	    break;
+	case matchTrace3:
+	    ++t;
+	    erts_printf("Trace3\n");
+	    break;
+ 	case matchCaller:
+ 	    ++t;
+ 	    erts_printf("Caller\n");
+ 	    break;
+	default:
+	    erts_printf("??? (0x%08x)\n", *t);
+	    ++t;
+	    break;
+	}
+    }
+    erts_printf("\n\nterm_save: {");
+    first = 1;
+    for (tmp = prog->term_save; tmp; tmp = tmp->next) {
+	if (first)
+	    first = 0;
+	else
+	    erts_printf(", ");
+	erts_printf("0x%08x", (unsigned long) tmp);
+    }
+    erts_printf("}\n");
+    erts_printf("num_bindings: %d\n", prog->num_bindings);
+    erts_printf("heap_size: %bpu\n", prog->heap_size);
+    erts_printf("eheap_offset: %bpu\n", prog->eheap_offset);
+    erts_printf("stack_offset: %bpu\n", prog->stack_offset);
+    erts_printf("text: 0x%08x\n", (unsigned long) prog->text);
+    erts_printf("stack_size: %d (words)\n", prog->heap_size-prog->stack_offset);
+    
+}
+
+#endif /* DMC_DEBUG */
+
+