xref: /dports/mail/mailfromd/mailfromd-8.10/src/prog.c

/* This file is part of Mailfromd.
   Copyright (C) 2006-2021 Sergey Poznyakoff

   This program is free software; you can redistribute it and/or modify
   it under the terms of the GNU General Public License as published by
   the Free Software Foundation; either version 3, or (at your option)
   any later version.

   This program is distributed in the hope that it will be useful,
   but WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   GNU General Public License for more details.

   You should have received a copy of the GNU General Public License
   along with this program.  If not, see <http://www.gnu.org/licenses/>. */

#ifdef HAVE_CONFIG_H
# include <config.h>
#endif
#include <setjmp.h>
#include <stdarg.h>
#include <sys/types.h>
#include <sys/socket.h>
#include <netinet/in.h>
#include <netdb.h>
#include <arpa/inet.h>
#include <assert.h>
#include <fnmatch.h>
#include <syslog.h>
#include "mailfromd.h"
#include "prog.h"
#include "msg.h"
#include "optab.h"
#include "builtin.h"
#include "mflib/_register.h"
#include "global.h"


/* Code generation support */
#define CODE_INITIAL    128
#define CODE_INCREMENT  128

static prog_counter_t pc, pmax;
mf_code_cell_t *prog;
size_t stack_size = STACK_SIZE;
size_t stack_max_size = 0;
size_t stack_expand_incr = STACK_INCR;
enum stack_expand_policy stack_expand_policy = stack_expand_add;

/* Data segment */
STKVAL *dataseg;
size_t datasize;
size_t dvarsize;

/* Table of relocatable entries in the data segment */
size_t *dataseg_reloc;
size_t dataseg_reloc_count;

/* Regular expressions */
struct rt_regex *regtab;
size_t regcount;
mu_opool_t regpool;

void
code_init()
{
	pmax = CODE_INITIAL;
	prog = calloc(pmax, sizeof prog[0]);
	if (!prog) {
		mu_error(_("not enough memory"));
		exit(1);
	}
}

prog_counter_t
code_get_counter()
{
	return pc;
}

prog_counter_t
code_reserve(size_t count)
{
	prog_counter_t ret = pc;
	if (pc + count > pmax) {
		size_t incr = (pc + count - pmax + CODE_INCREMENT - 1)
 			       / CODE_INCREMENT;
		pmax += incr * CODE_INCREMENT;
		prog = realloc(prog, pmax*sizeof prog[0]);
		if (!prog) {
			mu_error(_("not enough memory"));
			exit(1);
		}
	}
	pc += count;
	return ret;
}

prog_counter_t
code_cell(mf_code_cell_t cell)
{
	if (pc >= pmax) {
		pmax += CODE_INCREMENT;
		prog = realloc(prog, pmax*sizeof prog[0]);
		if (!prog) {
			mu_error(_("not enough memory"));
			exit(1);
		}
	}
	prog[pc] = cell;
	return pc++;
}

prog_counter_t
code_instr(const instr_t ptr)
{
	return code_cell((mf_code_cell_t)ptr);
}

prog_counter_t
code_op(unsigned code)
{
	return code_cell((mf_code_cell_t)(STKVAL)code);
}

prog_counter_t
code_immediate_stkval(STKVAL val)
{
	return code_cell((mf_code_cell_t)val);
}

prog_counter_t
code_exmask(struct exmask *exmask)
{
	return code_immediate(exmask->off, size);
}

void
code_put_stkval(prog_counter_t pos, STKVAL val)
{
	assert(pos < pmax);
	prog[pos].c_value = val;
}

mf_code_cell_t
code_peek(prog_counter_t pos)
{
	assert(pos < pmax);
	return prog[pos];
}

static size_t transform_count;
static size_t transform_max;
static transform_t *transform_tab;

size_t
next_transform_index(void)
{
	if (transform_count == transform_max) {
		transform_tab = mu_2nrealloc(transform_tab,
					     &transform_max,
					     sizeof(transform_tab[0]));
	}
	transform_tab[transform_count] = NULL;
	return transform_count++;
}

void
install_transform(size_t index, transform_t tp)
{
	transform_tab[index] = tp;
}

transform_t
get_transform(size_t index)
{
	return transform_tab[index];
}

/* Regexps*/

void
register_regex(struct sym_regex *rp)
{
	struct rt_regex r;
	if (regcount == 0)
		mu_opool_create(&regpool, MU_OPOOL_ENOMEMABRT);
	r.compiled = 0; /* Will be compiled later */
	r.expr = rp->lit ? rp->lit->off : 0;
	r.regflags = rp->regflags;
	rp->index = regcount++;
	mu_opool_append(regpool, &r, sizeof r);
}

void
finalize_regex()
{
	if (regcount)
		regtab = mu_opool_finish(regpool, NULL);
}


#define PROG_TRACE_ENGINE (builtin_module_trace(BUILTIN_IDX_prog))

static void
set_prog_trace(const char *modlist, int val)
{
	while (1) {
		size_t len = strcspn(modlist, ",");
		if (len == 3 && memcmp(modlist, "all", 3) == 0)
			builtin_set_all_module_trace(val);
		else if (len == 4 && memcmp(modlist, "none", 4) == 0)
			builtin_set_all_module_trace(!val);
		else {
			if (len > 3 && memcmp (modlist, "no-", 3) == 0)
				builtin_set_module_trace(modlist+3, len-3,
							 !val);
			else
				builtin_set_module_trace(modlist, len, val);
		}
		modlist += len;
		if (*modlist)
			modlist++;
		else
			break;
	}
}

void
enable_prog_trace(const char *modlist)
{
	set_prog_trace(modlist, 1);
}

void
disable_prog_trace(const char *modlist)
{
	set_prog_trace(modlist, 0);
}

/* ========================================================================
    Drzewa w górę, rzeki w dół.

                    Jacek Kaczmarski.
		    "Upadek Ikara"
   ======================================================================== */

/* Run-time evaluation */

/* Max. number of C locals to save in struct eval_environ for eventual fixups.
   See comment to env_fixup_autos, below. */
#define MAX_AUTO_PTR 128

struct exception_context {
	prog_counter_t pc;
	prog_counter_t tos;
	prog_counter_t base;
};

#define TOS_INVARIANT(env,t) (datasize + (env)->stack_size - (t))

struct environ_locus {
	unsigned long file;   /* File name */
	unsigned int line;   /* Line number */
};

struct environ_cleanup_closure {
	void (*cleanup)(void *);
	void *data;
};

struct eval_environ {
	prog_counter_t pc;     /* Program counter */

	prog_counter_t tos;    /* Top of stack:
                                     toh <= tos < datasize + stack_size */
	prog_counter_t toh;    /* Top of heap:
 			             datasize <= toh <= tos */

	prog_counter_t base;   /* Base pointer */
	STKVAL reg;            /* General purpose register */
	STKVAL *dataseg;       /* Data space */
	size_t stack_size;     /* Size of allocated stack + heap */

	/* Program locus corresponding to PC */
	struct environ_locus locus;

	/* Temporary heap space */
	size_t temp_start;
	size_t temp_size;

	STKVAL *auto_ptr[MAX_AUTO_PTR]; /* Pointers to C automatic variables
					   referring to dataseg. */
	size_t numautos;                /* Number of entries in auto_ptr. */

	/* Sendmail interaction data: */
	SMFICTX *ctx;          /* Milter Context */
	void *data;            /* MTA symbol table */
	/* methods to access the latter */
	const char *(*getsym)(void *data, const char *str);
	int (*setreply)(void *data, char *code, char *xcode, char *message);
	void (*msgmod)(void *data, struct msgmod_closure *c);

	/* Regular expression matching */
	regmatch_t *matches;   /* Match map */
	size_t matchcount;     /* Number of used entries in matches */
	size_t matchsize;      /* Total number of entries in matches */
	prog_counter_t matchstr; /* Pointer to the last matched string
				    in the dataseg. */

	mu_stream_t stream;    /* Capture stream */
	size_t line_count;     /* Number of lines in stream */
	int reposition;        /* When !0, stream must be repositioned to
				  its end before writing. */
	mu_header_t header;    /* Headers from stream, converted to a MU
				  object. */

	/* Message modification queue */
	mu_list_t mmq;

	/* Non-local exits */
	struct exception_context *defcatch_ctx;
	struct exception_context *catch_ctx;

	/* Built-in private data */
	void **bi_priv_array;

	/* Function clean-up sequence */
	mu_list_t function_cleanup_list;

	mu_list_t environ_cleanup_list;

	/* Exit information */
	sfsistat status;       /* Program exit status */
	jmp_buf x_jmp;         /* Return point for runtime errors */
	jmp_buf catch_jmp;     /* Return point for throws */
};

#define ENV_LOC_FILE(env) \
    ((const char*)((env)->dataseg + (size_t) (env)->locus.file))
#define ENV_LOC_LINE(env) ((env)->locus.line)

void
advance_pc(eval_environ_t env, long cnt)
{
	env->pc += cnt;
}

void
adjust_stack(eval_environ_t env, unsigned cnt)
{
	env->tos += cnt;
}

void
unroll_stack(eval_environ_t env, unsigned cnt)
{
	env->tos -= cnt;
}

prog_counter_t
env_register_read(eval_environ_t env, int what)
{
	switch (what) {
	case REG_PC:
		return env->pc;

	case REG_TOS:
		return env->tos;

	case REG_TOH:
		return env->toh;

	case REG_BASE:
		return env->base;

	case REG_REG:
		return (prog_counter_t) mf_c_val(env->reg, ulong);

	case REG_MATCHSTR:
		return env->matchstr;
	}
	return -1;
}

size_t
env_base(eval_environ_t env, size_t frame)
{
	size_t base = env->base;
	for (; frame; frame--)
		base = mf_c_val(env->dataseg[base + 1], size) + base + 1;
	return base;
}

char *
env_vaptr(eval_environ_t env, size_t off)
{
	return (char*)(env->dataseg + mf_c_val(env->dataseg[off], size));
}

void
env_var_inc(eval_environ_t env, size_t off)
{
	++mf_c_val(*env_data_ref(env, off), long);
}

static void env_register_auto(eval_environ_t env, void *ptr);

void
env_get_locus(eval_environ_t env, struct mu_locus_range *locus)
{
	mu_locus_range_init(locus);
	locus->beg.mu_file = (char*)(env->dataseg + env->locus.file);
	env_register_auto(env, (void*) &locus->beg.mu_file);
	locus->beg.mu_line = env->locus.line;
#if 0
	locus->beg.mu_col = env->locus.point;
	...
#endif
}

const char *
env_get_macro(eval_environ_t env, const char *symbol)
{
	return env->getsym(env->data, symbol);
}

int
env_get_stream(eval_environ_t env, mu_stream_t *pstr)
{
	return mu_streamref_create(pstr, env->stream);
}

STKVAL
env_get_reg(eval_environ_t env)
{
	return env->reg;
}

void
env_reposition(eval_environ_t env)
{
	env->reposition = 1;
}

static int
_cleanup_compare(const void *a, const void *b)
{
	struct environ_cleanup_closure const *closa = a;
	struct environ_cleanup_closure const *closb = b;
	return closa->data != closb->data;
}

static void
_cleanup_destroy(void *item)
{
	struct environ_cleanup_closure *clos = item;
	if (clos->cleanup)
		clos->cleanup(clos->data);
}

static void
env_cleanup_list_create(mu_list_t *plist)
{
	mu_list_t list;
	mu_list_create(&list);//FIXME: error checking
	mu_list_set_destroy_item(list, _cleanup_destroy);
	mu_list_set_comparator(list, _cleanup_compare);
	*plist = list;
}

static void
env_cleanup_list_append(mu_list_t list, void *data, void (*func)(void *))
{
	struct environ_cleanup_closure *clos = mu_zalloc(sizeof(*clos));

	clos->cleanup = func ? func : free;
	clos->data = data;
	mu_list_append(list, clos);
}

void
env_function_cleanup_flush(eval_environ_t env, void *ptr)
{
	if (ptr) {
		struct environ_cleanup_closure clos;
		clos.data = ptr;
		mu_list_remove(env->function_cleanup_list, &clos);
	} else {
		mu_list_clear(env->function_cleanup_list);
	}
}

void
env_function_cleanup_del(eval_environ_t env, void *ptr)
{
	int rc;
	struct environ_cleanup_closure clos, *cptr;

	clos.data = ptr;

	rc = mu_list_locate(env->function_cleanup_list, &clos, (void**)&cptr);
	if (rc == 0) {
		cptr->cleanup = NULL;
		mu_list_remove(env->function_cleanup_list, &clos);
	}
}

void
env_function_cleanup_add(eval_environ_t env, void *data, void (*func)(void *))
{
	env_cleanup_list_append(env->function_cleanup_list, data, func);
}

void
env_environ_cleanup_add(eval_environ_t env, void *data, void (*func)(void *))
{
	env_cleanup_list_append(env->environ_cleanup_list, data, func);
}

/* A call to expand_dataseg (see below) invalidates any C variables that
   pointed to the dataseg before the call. To avoid dereferencing invalid
   memory pointers, addresses of such C variables are stored in env->auto_ptr
   using env_register_auto (it is done by get_string_arg). When
   expand_dataseg is called, it calls env_fixup_autos and passes it the
   offset of the new dataseg from the old one. Env_fixup_autos adds this
   value to every address in auto_ptr, thereby fixing them.

   The auto_ptr array is cleared (by calling env_unregister_autos) after
   executing each instruction (see eval_environment).
 */
static void
env_register_auto(eval_environ_t env, void *ptr)
{
	char *addr = *(char**)ptr;

	if (env->numautos == MAX_AUTO_PTR)
		runtime_error(env, "INTERNAL ERROR at %s:%d, please report",
			      __FILE__, __LINE__);
	/* Check if address is within the dataseg */
	if (!(addr >= (char*) env->dataseg
	      && (addr < (char*) (env->dataseg + datasize + env->stack_size))))
		ptr = NULL;
	env->auto_ptr[env->numautos++] = ptr;
}

/* Pop the last registered auto variable */
static void
env_pop_auto(eval_environ_t env)
{
	env->numautos--;
}

static void
env_unregister_autos(eval_environ_t env)
{
	env->numautos = 0;
}

static void
env_fixup_autos(eval_environ_t env, ptrdiff_t offset)
{
	int i;
	for (i = 0; i < env->numautos; i++) {
		STKVAL *pptr = env->auto_ptr[i];
		if (pptr)
			mf_c_val(*pptr,str) += offset; /*FIXME*/
	}
}


int
expand_dataseg(eval_environ_t env, size_t count)
{
	STKVAL *newds;
	ptrdiff_t offset;
	size_t new_stack_size;
	size_t diff;
	enum { DATASEG_MAX = ((size_t)-1) / sizeof(STKVAL) };

	switch (stack_expand_policy) {
	case stack_expand_add:
		diff = ((count + stack_expand_incr - 1) / stack_expand_incr)
			* stack_expand_incr;
		if (DATASEG_MAX - diff < env->stack_size)
			return -1;
		new_stack_size = env->stack_size + diff;
		break;

	case stack_expand_twice:
		new_stack_size = env->stack_size;
		do {
			if (DATASEG_MAX / 2 < new_stack_size)
				return -1;
			new_stack_size *= 2;
			diff = new_stack_size - env->stack_size;
		} while (diff < count);
	}

	if ((stack_max_size && new_stack_size > stack_max_size)
	    || DATASEG_MAX - datasize < new_stack_size
	    || (newds = realloc(env->dataseg,
				(new_stack_size + datasize)
				* sizeof env->dataseg[0])) == NULL)
		return 1;

	offset = (char*)newds - (char*)env->dataseg;
	env->dataseg = newds;
	env->stack_size = new_stack_size;
	env->tos += diff;
	env->base += diff;
	memmove(newds + env->tos, newds + env->tos - diff,
		(datasize + env->stack_size - env->tos)
 		  * sizeof newds[0]);
	env_fixup_autos(env, offset);
	mu_diag_output(MU_DIAG_WARNING,
		       _("stack segment expanded, new size=%lu"),
		       (unsigned long) env->stack_size);
	return 0;
}


void
prog_trace(eval_environ_t env, const char *fmt, ...)
{
	char buf[512];
	va_list ap;

	va_start(ap, fmt);
	vsnprintf(buf, sizeof buf, fmt, ap);
	va_end(ap);
	logmsg(MU_LOG_DEBUG, "%4lu: %s:%u: %s",
	       (unsigned long) env->pc,
	       ENV_LOC_FILE(env), ENV_LOC_LINE(env),
	       buf);
}

void instr_funcall(eval_environ_t env);
void instr_locus(eval_environ_t env);

void
runtime_stack_trace(eval_environ_t env)
{
	size_t base;

	mu_error(_("stack trace:"));
	for (base = env->base; base < datasize + env->stack_size - 4;
	     base = mf_c_val(env->dataseg[base + 1], size) + base + 1) {
		int i;
		prog_counter_t pc = mf_c_val(env->dataseg[base + 2], ulong) - 1;
		char *name;
		struct mu_locus_point *ploc = NULL, loc;

		if (pc < 2)
			break; /*FIXME*/
		if (mf_cell_instr(prog[pc-2]) == instr_funcall) {
			name = (char*)(env->dataseg + mf_cell_c_value(prog[pc-1], size));
			pc -= 2;
		} else {
			name = "(in catch)";
			pc -= 3;
		}

		for (i = 0; i < 10; i++) {
			if (pc > i + 3
			    && prog[pc - i - 3].c_instr == instr_locus) {
				loc.mu_file = (char*)(env->dataseg
						   + mf_cell_c_value(prog[pc - i - 2], size));
				loc.mu_line = mf_cell_c_value(prog[pc - i - 1], size);
				ploc = &loc;
				break;
			}
		}

		if (ploc)
			mu_error("%04lu: %s:%u: %s",
				 (unsigned long) pc,
				 ploc->mu_file, ploc->mu_line, name);
		else
			mu_error("%04lu: %s",
				 (unsigned long) pc, name);
	}
	mu_error(_("stack trace finishes"));
}

void
runtime_warning(eval_environ_t env, const char *fmt, ...)
{
	va_list ap;

	mu_diag_printf(MU_DIAG_WARNING,
		       _("RUNTIME WARNING near %s:%u: "),
		       ENV_LOC_FILE(env), ENV_LOC_LINE(env));
	va_start(ap, fmt);
	mu_diag_cont_printf(fmt, ap);
	va_end(ap);
	mu_diag_cont_printf("\n");
}

void
runtime_error(eval_environ_t env, const char *fmt, ...)
{
	int n;
	va_list ap;
	char buf[512];

	n = snprintf(buf, sizeof buf, _("RUNTIME ERROR near %s:%u: "),
		     ENV_LOC_FILE(env), ENV_LOC_LINE(env));
	va_start(ap, fmt);
	vsnprintf(buf + n, sizeof buf - n, fmt, ap);
	va_end(ap);
	mu_error("%s", buf);
	if (stack_trace_option)
		runtime_stack_trace(env);
	env->status = SMFIS_TEMPFAIL; /* FIXME */
	longjmp(env->x_jmp, 1);
}

STKVAL
get_immediate(eval_environ_t env, unsigned n)
{
	return mf_cell_value(prog[env->pc + n + 1]);
}

static void
get_literal(eval_environ_t env, unsigned n, const char **p)
{
	*p = (char*)(env->dataseg + mf_c_val(get_immediate(env, n), size));
	env_register_auto(env, p);
}

STKVAL
get_arg(eval_environ_t env, unsigned n)
{
	return env->dataseg[env->tos + n + 1];
}

void
get_string_arg(eval_environ_t env, unsigned n, char * MFL_DATASEG *p)
{
	*p = (char*) (env->dataseg + mf_c_val(get_arg(env, n), size));
	env_register_auto(env, (void*) p);
}

void
get_numeric_arg(eval_environ_t env, unsigned n, long *np)
{
	*np = mf_c_val(get_arg(env, n), long);
}

void
get_pointer_arg(eval_environ_t env, unsigned n, void * MFL_DATASEG *p)
{
	*p = mf_c_val(get_arg(env, n), ptr);
}

void
push(eval_environ_t env, STKVAL val)
{
	if (env->tos < env->toh)
		runtime_error(env, "INTERNAL ERROR at %s:%d, please report",
			      __FILE__, __LINE__);
	if (env->tos == env->toh) {
		mu_debug(MF_SOURCE_PROG, MU_DEBUG_TRACE8,
			 ("tos=%lu, toh=%lu",
			  (unsigned long) env->tos,
			  (unsigned long) env->toh));
		if (expand_dataseg(env, 1))
			runtime_error(env, "%s",
				      _("out of stack space; increase #pragma stacksize"));
	}
	env->dataseg[env->tos--] = val;
}

STKVAL
pop(eval_environ_t env)
{
	if (env->tos == datasize + env->stack_size - 1)
		runtime_error(env, _("stack underflow"));
	return env->dataseg[++env->tos];
}

size_t
heap_reserve_words(eval_environ_t env, size_t words)
{
	size_t off = env->toh;
        if (env->toh + words > env->tos) {
		if (expand_dataseg(env, words))
			runtime_error(env, "%s",
				      _("heap overrun; increase #pragma stacksize"));
	}
        env->toh += words;
        return off;
}

size_t
heap_reserve(eval_environ_t env, size_t size)
{
	return heap_reserve_words(env, B2STACK(size));
}

STKVAL
heap_tempspace(eval_environ_t env, size_t size)
{
	size_t words = B2STACK(size);
	STKVAL ret;
        if (env->toh + words > env->tos) {
		if (expand_dataseg(env, words))
			runtime_error(env, "%s",
				      _("heap overrun; increase #pragma stacksize"));
	}
        mf_c_val(ret, ptr) = env->dataseg + env->toh;
	return ret;
}

void
heap_obstack_begin(eval_environ_t env)
{
	env->temp_start = env->toh;
	env->temp_size = 0;
}

void
heap_obstack_cancel(eval_environ_t env)
{
	env->toh = env->temp_start;
	env->temp_start = 0;
	env->temp_size = 0;
}

STKVAL
heap_obstack_finish(eval_environ_t env)
{
	STKVAL ret;
	mf_c_val(ret, size) = env->temp_start;
	env->temp_start = 0;
	env->temp_size = 0;
	return ret;
}

static inline size_t
heap_obstack_size(eval_environ_t env)
{
	return (env->tos - env->toh - B2STACK(env->temp_size))
		* sizeof env->dataseg[0];
}

void
heap_obstack_vsprintf(eval_environ_t env, const char *fmt, va_list ap)
{
	size_t n;
	while (1) {
		size_t size;
		va_list apc;

		if (env->tos == env->toh)
			if (expand_dataseg(env, B2STACK(strlen(fmt)))) {
				runtime_error(env, "%s",
					      _("memory chunk too big to fit into heap"));
			}

		size = heap_obstack_size(env);
		va_copy(apc, ap);
		n = vsnprintf((char*) env_data_ref(env, env->temp_start) + env->temp_size,
			      size, fmt, apc);
		va_end(apc);
		if (n >= size) {
			if (expand_dataseg(env, B2STACK(n))) {
				runtime_error(env, "%s",
					      _("memory chunk too big to fit into heap"));
			}
			continue;
		}
		break;
	}
	env->temp_size += n;
	env->toh += B2STACK(n);
}

void
heap_obstack_sprintf(eval_environ_t env, const char *fmt, ...)
{
	va_list ap;
	va_start(ap, fmt);
	heap_obstack_vsprintf(env, fmt, ap);
	va_end(ap);
}

void *
heap_obstack_grow(eval_environ_t env, void * MFL_DATASEG ptr, size_t size)
{
	size_t words = B2STACK(size);
	char *ret;

	env_register_auto(env, (void*) &ptr);
	if (env->tos - env->toh < words + B2STACK(env->temp_size)) {
		if (expand_dataseg(env, words))
			runtime_error(env, "%s",
				      _("memory chunk too big to fit into heap"));
	}
	ret = (char*) env_data_ref(env, env->temp_start) + env->temp_size;
	if (ptr)
		memmove(ret, ptr, size);
	env->temp_size += size;
	env->toh += words;
	env_pop_auto(env);
	return ret;
}

void *
heap_obstack_base(eval_environ_t env)
{
	return (void*) env_data_ref(env, env->temp_start);
}

STKVAL *
env_data_ref(eval_environ_t env, size_t off)
{
	return env->dataseg + off;
}

void
pushs(eval_environ_t env, const char * MFL_DATASEG s)
{
	size_t off;

	env_register_auto(env, (void*) &s);
	off = heap_reserve(env, strlen(s) + 1);
	strcpy((char*) env_data_ref(env, off), s);
	env_pop_auto(env);
	push(env, (STKVAL) off);
}

void
pushn(eval_environ_t env, long n)
{
	push(env, (STKVAL) n);
}

/* Auxiliary instructions */

void
instr_locus(eval_environ_t env)
{
	env->locus.file = mf_c_val(get_immediate(env, 0), uint);
	env->locus.line = mf_c_val(get_immediate(env, 1), uint);
	if (PROG_TRACE_ENGINE)
		prog_trace(env, "LOCUS");
	advance_pc(env, 2);
}

void
dump_locus(prog_counter_t i)
{
	printf("\"%s\" %lu",
	       (char*) (dataseg + mf_cell_c_value(prog[i], size)),
	       (unsigned long) mf_cell_c_value(prog[i+1], size));
}

/* Stack manipulation instructions */
void
instr_xchg(eval_environ_t env)
{
	prog_counter_t p = env->tos + 1;
	STKVAL tmp = env->dataseg[p];
	env->dataseg[p] = env->dataseg[p + 1];
	env->dataseg[p + 1] = tmp;
	if (PROG_TRACE_ENGINE)
		prog_trace(env, "XCHG");
}

void
instr_dup(eval_environ_t env)
{
	if (PROG_TRACE_ENGINE)
		prog_trace(env, "DUP");
	push(env, get_arg(env, 0));
}

void
instr_pop(eval_environ_t env)
{
	if (PROG_TRACE_ENGINE)
		prog_trace(env, "POP");
	pop(env);
}

void
instr_push(eval_environ_t env)
{
	if (PROG_TRACE_ENGINE)
		prog_trace(env, "PUSH %p",
			   mf_c_val(get_immediate(env, 0), ptr));
	push(env, get_immediate(env, 0));
	advance_pc(env, 1);
}

void
dump_push(prog_counter_t i)
{
	printf("%lx", mf_cell_c_value(prog[i], ulong));
}

void
instr_memstk(eval_environ_t env)
{
	size_t frame = mf_c_val(get_immediate(env, 0), size);
	long off = mf_c_val(get_immediate(env, 1), long);
	size_t val;

	/* The naive approach would be to just

	      push(env, env_base(env, frame) + off)

	   However, push() itself might cause dataseg expansion,
	   which would change tos/toh pointers and render the previously
	   computed argument value invalid.  The correct way is to push
	   a placeholder value first, thereby occupying stack slot and
	   eventually causing dataseg expansion, and then compute val
	   using actual environment:
	*/

	push(env, (STKVAL)0L);
	val = env_base(env, frame) + off;
	env->dataseg[env->tos+1] = (STKVAL)val;

	if (PROG_TRACE_ENGINE)
		prog_trace(env, "MEMSTK %lu(%ld)=%lu",
			   (unsigned long) frame, off,
			   (unsigned long) val);
	advance_pc(env, 2);
}

void
dump_memstk(prog_counter_t i)
{
	printf("%lu(%ld)",
	       mf_cell_c_value(prog[i], ulong),
	       mf_cell_c_value(prog[i+1], long));
}

void
instr_xmemstk(eval_environ_t env)
{
	size_t frame = mf_c_val(get_arg(env, 1), size);
	long off = mf_c_val(get_arg(env, 0), long);
	size_t val;

	adjust_stack(env, 2);

	/* See comment in instr_memstk, above */
	push(env, (STKVAL)0L);
	val = env_base(env, frame) + off;
	env->dataseg[env->tos+1] = (STKVAL)val;

	if (PROG_TRACE_ENGINE)
		prog_trace(env, "XMEMSTK %lu(%ld)=%lu",
			   (unsigned long) frame, off,
			   (unsigned long) val);
}

void
instr_deref(eval_environ_t env)
{
	size_t off = mf_c_val(get_arg(env, 0), size);
	STKVAL val = env->dataseg[off];

	if (PROG_TRACE_ENGINE)
		prog_trace(env, "DEREF %lu=%lu (%p)",
			   (unsigned long) off,
			   mf_c_val(val, ulong), mf_c_val(val, ptr));
	adjust_stack(env, 1);
	push(env, val);
}

void
instr_stkalloc(eval_environ_t env)
{
	unsigned n = mf_c_val(get_immediate(env, 0), uint);
	if (PROG_TRACE_ENGINE)
		prog_trace(env, "STKALLOC %x", n);
	if (env->tos - n < env->toh) {
		mu_debug(MF_SOURCE_PROG, MU_DEBUG_TRACE8,
			 ("tos=%lu, toh=%lu, delta=%u",
			  (unsigned long) env->tos,
			  (unsigned long) env->toh,
			  n));
		if (expand_dataseg(env, env->toh - (env->tos - n)))
			runtime_error(env, "%s",
				      _("Out of stack space; increase #pragma stacksize"));
	}
	env->tos -= n;
	advance_pc(env, 1);
}

void
dump_stkalloc(prog_counter_t i)
{
	printf("%u", mf_cell_c_value(prog[i], uint));
}

void
instr_backref(eval_environ_t env)
{
	unsigned n = mf_c_val(get_immediate(env, 0), uint);
	size_t matchlen;

	if (PROG_TRACE_ENGINE)
		prog_trace(env, "BACKREF %u",
			   mf_c_val(get_immediate(env, 0), uint));
	advance_pc(env, 1);

	if (!env->matches || !env->matchstr) {
		/* FIXME: Try to throw exception first:
		   env_throw(env, mf_no_regex);
		*/
		runtime_error(env, _("no previous regular expression"));
	}
	if (n > env->matchcount) {
		/* FIXME: See above */
		runtime_error(env, _("invalid back-reference number"));
	}

	if (env->matches[n].rm_so == -1) {
		push(env, (STKVAL)0L);
	} else {
		char *s;
		size_t off;

		matchlen = env->matches[n].rm_eo - env->matches[n].rm_so;
		off = heap_reserve(env, matchlen + 1);
		s = (char*) env_data_ref(env, off);
		memcpy(s,
		       (const char *) &env->dataseg[env->matchstr] +
		       env->matches[n].rm_so, matchlen);
		s[matchlen] = 0;
		push(env, (STKVAL) off);
	}
}

void
dump_backref(prog_counter_t i)
{
	printf("%u", mf_cell_c_value(prog[i], uint));
}

/* Type conversion instructions */
void
instr_ston(eval_environ_t env)
{
	char *s;
	char *p;
	long v;

	get_string_arg(env, 0, &s);
	v = strtol(s, &p, 0);

	if (PROG_TRACE_ENGINE)
		prog_trace(env, "STON %s", s);
	adjust_stack(env, 1);
	if (*p)
		env_throw(env, mfe_ston_conv,
			  "Cannot convert stack value to number (stopped at %-.8s)",
			  p);

	push(env, (STKVAL) v);
}

void
instr_ntos(eval_environ_t env)
{
	long v = mf_c_val(get_arg(env, 0), long);
	char buf[NUMERIC_BUFSIZE_BOUND];

	if (PROG_TRACE_ENGINE)
		prog_trace(env, "NTOS %ld", v);
	adjust_stack(env, 1);

	snprintf(buf, sizeof buf, "%ld", v);
	pushs(env, buf);
}

/* Evaluation instructions */
void
instr_cmp(eval_environ_t env)
{
	long l = mf_c_val(get_arg(env, 1), long);
	long r = mf_c_val(get_arg(env, 0), long);

	if (PROG_TRACE_ENGINE)
		prog_trace(env, "CMP %ld %ld", l, r);
	adjust_stack(env, 2);
	pushn(env, l == r);
}

void
instr_symbol(eval_environ_t env)
{
	char *symbol;
	const char *s;

	get_literal(env, 0, (const char **)&symbol);
	s = env->getsym(env->data, symbol);

	if (PROG_TRACE_ENGINE)
		prog_trace(env, "SYMBOL %s", symbol);
	if (!s)
		env_throw(env, mfe_macroundef, _("macro not defined: %s"),
                          symbol);

	if (PROG_TRACE_ENGINE)
		prog_trace(env, "%s dereferenced to %s", symbol, s);

	advance_pc(env, 1);

	pushs(env, s);
}

void
dump_symbol(prog_counter_t i)
{
	printf("%08lx %s",
	       mf_cell_c_value(prog[i], ulong),
	       (char *) (dataseg + mf_cell_c_value(prog[i], size)));
}

/* Comparation instructions */
void
instr_eqn(eval_environ_t env)
{
	long a = mf_c_val(get_arg(env, 1), long);
	long b = mf_c_val(get_arg(env, 0), long);
	if (PROG_TRACE_ENGINE)
		prog_trace(env, "EQN %ld %ld", a, b);
	adjust_stack(env, 2);
	pushn(env, a == b);
}

void
instr_eqs(eval_environ_t env)
{
	char *a, *b;
	get_string_arg(env, 1, &a);
	get_string_arg(env, 0, &b);
	if (PROG_TRACE_ENGINE)
		prog_trace(env, "EQS %s %s", a, b);
	adjust_stack(env, 2);
	pushn(env, strcmp(a, b) == 0);
}

void
instr_nen(eval_environ_t env)
{
	long a = mf_c_val(get_arg(env, 1), long);
	long b = mf_c_val(get_arg(env, 0), long);
	if (PROG_TRACE_ENGINE)
		prog_trace(env, "NEN %ld %ld", a, b);
	adjust_stack(env, 2);
	pushn(env, a != b);
}

void
instr_nes(eval_environ_t env)
{
	char *a, *b;

	get_string_arg(env, 1, &a);
	get_string_arg(env, 0, &b);
	if (PROG_TRACE_ENGINE)
		prog_trace(env, "NES %s %s", a, b);
	adjust_stack(env, 2);
	pushn(env, strcmp(a, b) != 0);
}

void
instr_ltn(eval_environ_t env)
{
	long a = mf_c_val(get_arg(env, 1), long);
	long b = mf_c_val(get_arg(env, 0), long);
	if (PROG_TRACE_ENGINE)
		prog_trace(env, "LTN %ld %ld", a, b);
	adjust_stack(env, 2);
	pushn(env, a < b);
}

void
instr_lts(eval_environ_t env)
{
	char *a, *b;

	get_string_arg(env, 1, &a);
	get_string_arg(env, 0, &b);
	if (PROG_TRACE_ENGINE)
		prog_trace(env, "LTS %s %s", a, b);
	adjust_stack(env, 2);
	pushn(env, strcmp(a, b) < 0);
}

void
instr_len(eval_environ_t env)
{
	long a = mf_c_val(get_arg(env, 1), long);
	long b = mf_c_val(get_arg(env, 0), long);
	if (PROG_TRACE_ENGINE)
		prog_trace(env, "LEN %ld %ld", a, b);
	adjust_stack(env, 2);
	pushn(env, a <= b);
}

void
instr_les(eval_environ_t env)
{
	char *a, *b;

	get_string_arg(env, 1, &a);
	get_string_arg(env, 0, &b);
	if (PROG_TRACE_ENGINE)
		prog_trace(env, "LES %s %s", a, b);
	adjust_stack(env, 2);
	pushn(env, strcmp(a, b) <= 0);
}

void
instr_gtn(eval_environ_t env)
{
	long a = mf_c_val(get_arg(env, 1), long);
	long b = mf_c_val(get_arg(env, 0), long);
	if (PROG_TRACE_ENGINE)
		prog_trace(env, "GTN %ld %ld", a, b);
	adjust_stack(env, 2);
	pushn(env, a > b);
}

void
instr_gts(eval_environ_t env)
{
	char *a, *b;

	get_string_arg(env, 1, &a);
	get_string_arg(env, 0, &b);
	if (PROG_TRACE_ENGINE)
		prog_trace(env, "GTS %s %s", a, b);
	adjust_stack(env, 2);
	pushn(env, strcmp(a, b) > 0);
}

void
instr_gen(eval_environ_t env)
{
	long a = mf_c_val(get_arg(env, 1), long);
	long b = mf_c_val(get_arg(env, 0), long);
	if (PROG_TRACE_ENGINE)
		prog_trace(env, "GEN %ld %ld", a, b);
	adjust_stack(env, 2);
	pushn(env, a >= b);
}

void
instr_ges(eval_environ_t env)
{
	char *a, *b;

	get_string_arg(env, 1, &a);
	get_string_arg(env, 0, &b);
	if (PROG_TRACE_ENGINE)
		prog_trace(env, "GES %s %s", a, b);
	adjust_stack(env, 2);
	pushn(env, strcmp(a, b) >= 0);
}

/* Jump instructions */
void
instr_bz(eval_environ_t env)
{
	long v = mf_c_val(get_arg(env, 0), long);
	long off = mf_c_val(get_immediate(env, 0), long);

	if (PROG_TRACE_ENGINE)
		prog_trace(env, "BZ %ld (%ld)", off, v);
	adjust_stack(env, 1);
	if (v == 0)
		advance_pc(env, off);
	advance_pc(env, 1);
}

void
dump_branch (prog_counter_t i)
{
	printf("%ld (%ld)",
	       mf_cell_c_value(prog[i], long),
	       i + mf_cell_c_value(prog[i], long) + 1);
}

void
instr_bnz(eval_environ_t env)
{
	long v = mf_c_val(get_arg(env, 0), long);
	long off = mf_c_val(get_immediate(env, 0), long);

	if (PROG_TRACE_ENGINE)
		prog_trace(env, "BNZ %ld (%ld)", off, v);
	adjust_stack(env, 1);
	if (v != 0)
		advance_pc(env, off);
	advance_pc(env, 1);
}

void
instr_jmp(eval_environ_t env)
{
	long off = mf_c_val(get_immediate(env, 0), long);
	if (PROG_TRACE_ENGINE)
		prog_trace(env, "JMP %ld", off);
	advance_pc(env, off+1);
}

/* Longean instructions */
void
instr_not(eval_environ_t env)
{
	long v = mf_c_val(get_arg(env, 0), long);
	if (PROG_TRACE_ENGINE)
		prog_trace(env, "NOT %ld", v);
	adjust_stack(env, 1);
	pushn(env, !v);
}

/* Bitwise arithmetics */
void
instr_logand(eval_environ_t env)
{
	unsigned long a = mf_c_val(get_arg(env, 1), ulong);
	unsigned long b = mf_c_val(get_arg(env, 0), ulong);
	if (PROG_TRACE_ENGINE)
		prog_trace(env, "LOGAND %lu %lu", a, b);
	adjust_stack(env, 2);
	pushn(env, a & b);
}

void
instr_logor(eval_environ_t env)
{
	unsigned long a = mf_c_val(get_arg(env, 1), ulong);
	unsigned long b = mf_c_val(get_arg(env, 0), ulong);
	if (PROG_TRACE_ENGINE)
		prog_trace(env, "LOGOR %lu %lu", a, b);
	adjust_stack(env, 2);
	pushn(env, a | b);
}

void
instr_logxor(eval_environ_t env)
{
	unsigned long a = mf_c_val(get_arg(env, 1), ulong);
	unsigned long b = mf_c_val(get_arg(env, 0), ulong);
	if (PROG_TRACE_ENGINE)
		prog_trace(env, "LOGXOR %lu %lu", a, b);
	adjust_stack(env, 2);
	pushn(env, a ^ b);
}

void
instr_lognot(eval_environ_t env)
{
	unsigned long v = mf_c_val(get_arg(env, 0), ulong);
	if (PROG_TRACE_ENGINE)
		prog_trace(env, "LOGNOT %ld", v);
	adjust_stack(env, 1);
	pushn(env, ~v);
}

/* Arithmetic instructions */
void
instr_add(eval_environ_t env)
{
	long a = mf_c_val(get_arg(env, 1), long);
	long b = mf_c_val(get_arg(env, 0), long);
	if (PROG_TRACE_ENGINE)
		prog_trace(env, "ADD %ld %ld", a, b);
	adjust_stack(env, 2);
	pushn(env, a + b);
}

void
instr_sub(eval_environ_t env)
{
	long a = mf_c_val(get_arg(env, 1), long);
	long b = mf_c_val(get_arg(env, 0), long);
	if (PROG_TRACE_ENGINE)
                prog_trace(env, "SUB %ld %ld", a, b);
	adjust_stack(env, 2);
	pushn(env, a - b);
}

void
instr_mul(eval_environ_t env)
{
	long a = mf_c_val(get_arg(env, 1), long);
	long b = mf_c_val(get_arg(env, 0), long);
	if (PROG_TRACE_ENGINE)
		prog_trace(env, "MUL %ld %ld", a, b);
	adjust_stack(env, 2);
	pushn(env, a * b);
}

void
instr_div(eval_environ_t env)
{
	long a = mf_c_val(get_arg(env, 1), long);
	long b = mf_c_val(get_arg(env, 0), long);
	if (PROG_TRACE_ENGINE)
		prog_trace(env, "DIV %ld %ld", a, b);
	adjust_stack(env, 2);
	if (b == 0)
		env_throw(env, mfe_divzero,
			  "Division by zero at %08x", (unsigned int) env->pc);
	pushn(env, a / b);
}

void
instr_mod(eval_environ_t env)
{
	long a = mf_c_val(get_arg(env, 1), long);
	long b = mf_c_val(get_arg(env, 0), long);
	if (PROG_TRACE_ENGINE)
		prog_trace(env, "MOD %ld %ld", a, b);
	adjust_stack(env, 2);
	if (b == 0)
		env_throw(env, mfe_divzero,
			  "Division by zero at %08x", (unsigned int) env->pc);
	pushn(env, a % b);
}

void
instr_shl(eval_environ_t env)
{
	long a = mf_c_val(get_arg(env, 1), long);
	long b = mf_c_val(get_arg(env, 0), long);
	if (PROG_TRACE_ENGINE)
		prog_trace(env, "SHL %ld %ld", a, b);
	adjust_stack(env, 2);
	pushn(env, a << (unsigned long) b);
}

void
instr_shr(eval_environ_t env)
{
	long a = mf_c_val(get_arg(env, 1), long);
	long b = mf_c_val(get_arg(env, 0), long);
	if (PROG_TRACE_ENGINE)
		prog_trace(env, "SHR %ld %ld", a, b);
	adjust_stack(env, 2);
	pushn(env, a >> (unsigned long) b);
}

void
instr_neg(eval_environ_t env)
{
	long v = mf_c_val(get_arg(env, 0), long);
	if (PROG_TRACE_ENGINE)
		prog_trace(env, "NEG %ld", v);
	adjust_stack(env, 1);
	pushn(env, -v);
}

/* Matching and Regular expression instructions */

/* REGEX: Basically it is useful only for debugging. Its effect is
   the same as that of instr_push */
void
instr_regex(eval_environ_t env)
{
	char buffer[REGEX_STRING_BUFSIZE];
	size_t index = mf_c_val(get_immediate(env, 0), size);

	if (PROG_TRACE_ENGINE)
		prog_trace(env, "REGEX (%s) %s",
			   regex_flags_to_string(regtab[index].regflags,
						 buffer,
						 sizeof buffer),
			   (char*) env_data_ref(env, regtab[index].expr));
	advance_pc(env, 1);
	push(env, (STKVAL) index);
}

void
dump_regex(prog_counter_t i)
{
	size_t index = mf_cell_c_value(prog[i], size);
	char buffer[REGEX_STRING_BUFSIZE];
	printf("(%s) %s",
	       regex_flags_to_string(regtab[index].regflags,
				     buffer, sizeof buffer),
	       (char*)(dataseg + regtab[index].expr));
}

void
instr_regmatch(eval_environ_t env)
{
	int v;
	size_t index = mf_c_val(get_arg(env, 0), size);
	regex_t *re = &regtab[index].re;
	char *string;

	get_string_arg(env, 1, &string);
	env->matchstr = (STKVAL*)string - env->dataseg;

	adjust_stack(env, 2);

	if (PROG_TRACE_ENGINE)
		prog_trace(env, "REGMATCH %s %s",
			   (char*)env_data_ref(env, regtab[index].expr),
			   string);

	env->matchcount = re->re_nsub;
	if (env->matchsize < env->matchcount + 1) {
		void *p = realloc(env->matches,
				  sizeof(env->matches[0])
				  * (env->matchcount + 1));
		if (!p)
			runtime_error(env, _("not enough memory"));
		env->matches = p;
		env->matchsize = env->matchcount + 1;
	}

	v = regexec(re, string, env->matchcount + 1, env->matches, 0);

	pushn(env, v == 0);
}

void
instr_regcomp(eval_environ_t env)
{
	int v;
	char buffer[REGEX_STRING_BUFSIZE];
	size_t expr_off = mf_c_val(get_arg(env, 0), size);
	char *expr;
	size_t index = mf_c_val(get_immediate(env, 0), size);
	struct rt_regex *rtx = &regtab[index];

	get_string_arg(env, 0, &expr);

	if (PROG_TRACE_ENGINE)
		prog_trace(env, "REGCOMP %s %s",
			   regex_flags_to_string(rtx->regflags,
						 buffer, sizeof buffer),
			   expr);

	advance_pc(env, 1);
	adjust_stack(env, 1);

	if (rtx->compiled) {
		regfree(&rtx->re);
		rtx->compiled = 0;
	}
	v = regcomp(&rtx->re, expr, rtx->regflags);
	if (v) {
		char errbuf[512];
		regerror(v, &rtx->re, errbuf, sizeof(errbuf));
		env_throw(env, mfe_regcomp,
			  "compiling regex `%s': %s",
			  expr,
			  errbuf);
	} else {
		rtx->compiled = 1;
		rtx->expr = expr_off;
	}
	push(env, (STKVAL) index);
}

void
dump_regcomp(prog_counter_t i)
{
	size_t index = mf_cell_c_value(prog[i], size);
	struct rt_regex *rtx = &regtab[index];
	char buffer[REGEX_STRING_BUFSIZE];
	printf("%s", regex_flags_to_string(rtx->regflags,
					   buffer, sizeof buffer));
}

void
instr_sedcomp(eval_environ_t env)
{
	char * MFL_DATASEG str;
	size_t index = mf_c_val(get_immediate(env, 0), size);
	transform_t *tp = &transform_tab[index];
	int flags = mf_c_val(get_immediate(env, 1), int);

	get_string_arg(env, 0, &str);
	if (PROG_TRACE_ENGINE)
		prog_trace(env, "SUBCOMP %s %zu %d", str, index, flags);

	advance_pc(env, 2);
	adjust_stack(env, 1);

	transform_free(*tp);

	*tp = transform_compile(str, flags);
	if (*tp == NULL)
		runtime_error(env,
			      _("invalid transform string \"%s\": %s"),
			      str,
			      transform_error_string());

	push(env, (STKVAL) index);
}

void
dump_sedcomp(prog_counter_t i)
{
	size_t index = mf_cell_c_value(prog[i], size);
	int flags = mf_cell_c_value(prog[i+1], int);
	printf("%zu %d", index, flags);
}

void
instr_sed(eval_environ_t env)
{
	char * MFL_DATASEG arg;
	long i = mf_c_val(get_arg(env, 0), long);
	char *res;

	get_string_arg(env, 1, &arg);

	if (PROG_TRACE_ENGINE)
		prog_trace(env, "SED %s %ld", arg, i);

	adjust_stack(env, 2);

	res = transform_string(transform_tab[i], arg);
	pushs(env, res);
	free(res);
}

void
instr_fnmatch(eval_environ_t env)
{
	char *string, *pattern;

	get_string_arg(env, 1, &string);
	get_string_arg(env, 0, &pattern);
	adjust_stack(env, 2);
	if (PROG_TRACE_ENGINE)
                prog_trace(env, "FNMATCH %s %s", string, pattern);
	pushn(env, fnmatch(pattern, string, 0) == 0);
}

static int
mx_match(eval_environ_t env, char *string,
	 int (*matcher)(const char *name, void *data), void *data)
{
	int rc = 0;
	struct dns_reply reply;
	mf_status mxstat;

	char *p = strchr(string, '@');
	if (p)
		p++;
	else
		p = string;
	mxstat = dns_to_mf_status(mx_lookup(p, 0, &reply));
	rc = 0;
	if (mxstat == mf_success) {
		int i;

		for (i = 0; i < reply.count; i++) {
			if (matcher(reply.data.str[i], data)) {
				rc = 1;
				break;
			}
		}
	}
	dns_reply_free(&reply);

	if (!mf_resolved(mxstat))
		env_throw(env, mf_status_to_exception(mxstat),
			  "cannot get MXs for %s", p);
	return rc;
}

static int
fn_matcher(const char *string, void *data)
{
	return fnmatch (data, string, 0) == 0;
}

void
instr_fnmatch_mx(eval_environ_t env)
{
	char *string, *pattern;

	get_string_arg(env, 1, &string);
	get_string_arg(env, 0, &pattern);
	adjust_stack(env, 2);

	if (PROG_TRACE_ENGINE)
		prog_trace(env, "FNMATCH,MX %s %s", string, pattern);
	pushn(env, mx_match(env, string, fn_matcher, pattern));
}

static int
regex_matcher(const char *string, void *data)
{
	return regexec(data, string, 0, NULL, 0) == 0;
}

void
instr_regmatch_mx(eval_environ_t env)
{
	int rc;
	size_t index = mf_c_val(get_arg(env, 0), size);
	regex_t *re = &regtab[index].re;
	char *string;

	get_string_arg(env, 1, &string);
	adjust_stack(env, 2);

	if (PROG_TRACE_ENGINE)
		prog_trace(env, "REGMATCH,MX %s %s",
			   (char*) env_data_ref(env, regtab[index].expr),
			   string);

	rc = mx_match(env, string, regex_matcher, re);

	pushn(env, rc);
}

/* Mail filter specific instructions */

void
instr_next(eval_environ_t env)
{
	if (PROG_TRACE_ENGINE)
		prog_trace(env, "NEXT");
	trace("%s%s:%u: next",
	      mailfromd_msgid(env->ctx),
	      ENV_LOC_FILE(env), ENV_LOC_LINE(env));
}

void
instr_result(eval_environ_t env)
{
	sfsistat status = (sfsistat) mf_c_val(get_immediate(env, 0), int);
	char *code, *xcode;
	char *message;

	get_string_arg(env, 2, &message);
	get_string_arg(env, 1, &xcode);
	get_string_arg(env, 0, &code);

	if (PROG_TRACE_ENGINE)
		prog_trace(env, "RESULT %d %s %s %s",
			   status,
			   SP(code),
			   SP(xcode),
			   SP(message));

	trace("%s%s:%u: %s %s %s %s",
	      mailfromd_msgid(env->ctx),
	      ENV_LOC_FILE(env), ENV_LOC_LINE(env),
	      sfsistat_str(status),
	      SP(code),
	      SP(xcode),
	      SP(message));

	if (code[0] == 0)
		code = NULL;
	if (xcode[0] == 0)
		xcode = NULL;

	if (status == SMFIS_ACCEPT && env_msgmod_count(env))
		runtime_warning(env, _("`accept' causes previous message "
				       "modification commands to be ignored; "
				       "call mmq_purge() prior to `accept', "
				       "to suppress this warning"));
	env->status = status;
	env->setreply(env->data, code, xcode, message);
	advance_pc(env, 1);
	adjust_stack(env, 3);
}

void
dump_result(prog_counter_t i)
{
	printf("%s", sfsistat_str((sfsistat)mf_cell_c_value(prog[i], int)));
}

void
instr_header(eval_environ_t env)
{
	struct msgmod_closure *hdr = mu_alloc (sizeof(*hdr));
	enum msgmod_opcode opcode =
		(enum msgmod_opcode) mf_c_val(get_immediate(env, 0), int);
	const char *name;
	char *value;

	get_string_arg(env, 0, &value);
	get_literal(env, 1, &name);

	advance_pc(env, 2);
	adjust_stack(env, 1);

	trace("%s%s:%u: %s %s %s",
	      mailfromd_msgid(env->ctx),
	      ENV_LOC_FILE(env), ENV_LOC_LINE(env),
	      msgmod_opcode_str(opcode),
	      name, SP(value));

	env_msgmod_append(env, opcode, name, value, 1);
}

void
dump_header(prog_counter_t i)
{
	printf("%s %s",
	       msgmod_opcode_str((enum msgmod_opcode) mf_cell_c_value(prog[i], int)),
	       (char*)(dataseg + mf_cell_c_value(prog[i+1], size)));
}

void
instr_builtin(eval_environ_t env)
{
	const char *name;
	void (*handler)(eval_environ_t) = mf_c_val(get_immediate(env, 1), ptr);

	get_literal(env, 0, &name);
	if (PROG_TRACE_ENGINE)
		prog_trace(env, "BUILTIN %s", name);
	advance_pc(env, 2);
	handler(env);
}

void
dump_builtin(prog_counter_t i)
{
	printf("%s ", (char*)(dataseg + mf_cell_c_value(prog[i], size)));
}

void
instr_concat(eval_environ_t env)
{
	char * MFL_DATASEG left, * MFL_DATASEG right;
	size_t off;
	char *res;

	get_string_arg(env, 1, &left);
	get_string_arg(env, 0, &right);
	off = heap_reserve(env, strlen(left) + strlen(right) + 1);
	res = (char*) env_data_ref(env, off);

	strcat(strcpy(res, left), right);
	adjust_stack(env, 2);
	if (PROG_TRACE_ENGINE)
		prog_trace(env, "CONCAT ('%s','%s')='%s'", left, right, res);
	push(env, (STKVAL) off);
}

void
dump_adjust(prog_counter_t i)
{
	printf("%lu ", mf_cell_c_value(prog[i], ulong));
}

void
instr_asgn(eval_environ_t env)
{
	STKVAL val = get_arg(env, 1);
	size_t dest = mf_c_val(get_arg(env, 0), size);
	adjust_stack(env, 2);
	if (PROG_TRACE_ENGINE)
		prog_trace(env, "ASGN %lu=%u",
			   (unsigned long) dest,
			   mf_c_val(val, uint));
	env->dataseg[dest] = val;
}

void
instr_catch(eval_environ_t env)
{
	long off = mf_c_val(get_immediate(env, 0), long);
	unsigned toff = mf_c_val(get_immediate(env, 1), uint);
	size_t count = mf_c_val(env->dataseg[toff], size);
	STKVAL *tab = (STKVAL *) (env->dataseg + toff + 1);
	size_t i;
	prog_counter_t entry = env->pc + 3;

	if (PROG_TRACE_ENGINE)
		prog_trace(env, "CATCH %ld, %ld", entry, off);

	for (i = 0; i < count * NBMBITS; i++)
		if (((bitmask_bits_t)mf_c_val(tab[BIT_WORD(i)], uint)) & BIT_MASK(i)) {
			if (PROG_TRACE_ENGINE)
				prog_trace(env, "CATCH TARGET: %lu %s",
					   (unsigned long) i,
					   mf_exception_str(i));
			env->catch_ctx[i].pc = entry;
			env->catch_ctx[i].tos =
				TOS_INVARIANT(env, env->tos);
			env->catch_ctx[i].base =
				TOS_INVARIANT(env, env->base);
		}

	advance_pc(env, off);
}

void
dump_catch(prog_counter_t i)
{
	size_t toff = mf_cell_c_value(prog[i+1], size);
	size_t count = mf_c_val(dataseg[toff], size);
	STKVAL *tab = (STKVAL *) (dataseg + toff + 1);
	printf("%ld (%ld)",
	       mf_cell_c_value(prog[i], long),
	       i + mf_cell_c_value(prog[i], long));
	printf("; Targets:");
	for (i = 0; i < count * NBMBITS; i++)
		if (((bitmask_bits_t)mf_c_val(tab[BIT_WORD(i)], uint)) & BIT_MASK(i))
			printf(" %s(%lu)", mf_exception_str(i), (unsigned long) i);
}

void
instr_throw(eval_environ_t env)
{
	unsigned long n = mf_c_val(get_immediate(env, 0), ulong);
	size_t off = mf_c_val(get_arg(env, 0), size);
	advance_pc(env, 1);
	adjust_stack(env, 1);
	if (n > exception_count)
		runtime_error(env, _("invalid exception number: %lu"), n);
	if (PROG_TRACE_ENGINE)
		prog_trace(env, "THROW %s(%ld)", mf_exception_str(n), n);
	env_throw_0(env, (mf_exception) n, off);
}

void
dump_throw(prog_counter_t i)
{
	printf("%s (%u)", mf_exception_str(mf_cell_c_value(prog[i], uint)),
	       mf_cell_c_value(prog[i], uint));
}


void
instr_echo(eval_environ_t env)
{
	char *str = (char*) env_data_ref(env, mf_c_val(pop(env), size));
	int rc = mu_stream_write(mf_strecho, str, strlen(str), NULL);
	if (rc == 0)
		rc = mu_stream_write(mf_strecho, "\n", 1, NULL);
	if (rc )
		logmsg(MU_LOG_EMERG, "cannot write to echo stream: %s",
		       mu_strerror (rc));
}

void
instr_return(eval_environ_t env)
{
	if (PROG_TRACE_ENGINE)
		prog_trace(env, "RETURN");
	env_leave_frame(env, 0);
	env->pc--;
}

void
instr_retcatch(eval_environ_t env)
{
	prog_counter_t pc = env->pc;
	if (PROG_TRACE_ENGINE)
		prog_trace(env, "RETCATCH");
	env_leave_frame(env, 2);
	env->pc = pc;
}

void
instr_saveex(eval_environ_t env)
{
	unsigned off = mf_c_val(get_immediate(env, 0), uint);
	size_t count = mf_c_val(env->dataseg[off], size);
	STKVAL *tab = (STKVAL *) (env->dataseg + off + 1);
	size_t i;

	if (PROG_TRACE_ENGINE)
		prog_trace(env, "SAVEEX %x (%lu ex.)", off,
			   (unsigned long) count);

	advance_pc(env, 1);
	for (i = 0; i < count * NBMBITS; i++)
		if (((bitmask_bits_t)mf_c_val(tab[BIT_WORD(i)], uint)) & BIT_MASK(i)) {
			mu_debug(MF_SOURCE_PROG, MU_DEBUG_TRACE9,
			      ("Push Exception: %lu %lu <- pc=%lu, tos=%lu, base=%lu",
			       (unsigned long) i,
			       (unsigned long) TOS_INVARIANT(env,env->tos),
			       (unsigned long) env->catch_ctx[i].pc,
			       (unsigned long) env->catch_ctx[i].tos,
			       (unsigned long) env->catch_ctx[i].base));
			push(env, (STKVAL) env->catch_ctx[i].pc);
			push(env, (STKVAL) env->catch_ctx[i].tos);
			push(env, (STKVAL) env->catch_ctx[i].base);
		}
	push(env, (STKVAL) off);
}

void
dump_saveex(prog_counter_t ctr)
{
	size_t off = mf_cell_c_value(prog[ctr], size);
	size_t count = mf_c_val(dataseg[off], size);
	STKVAL *tab = (STKVAL *) (dataseg + off + 1);
	size_t i;

	printf("%lu:", (unsigned long) count);
	for (i = 0; i < count; i++)
		if (((bitmask_bits_t)mf_c_val(tab[BIT_WORD(i)], uint)) & BIT_MASK(i))
			printf(" %lu", (unsigned long) i);
}

void
instr_restex(eval_environ_t env)
{
	unsigned off = mf_c_val(pop(env), uint);
	size_t count = mf_c_val(env->dataseg[off], size);
	STKVAL *tab = (STKVAL *) (env->dataseg + off + 1);
	size_t i;

	if (PROG_TRACE_ENGINE)
		prog_trace(env, "RESTEX %x (%lu ex.)",
			   off, (unsigned long) count);
	if (!count)
		return;
	i = count * NBMBITS - 1;
	do {
		i--;
		if (((bitmask_bits_t)mf_c_val(tab[BIT_WORD(i)], uint)) & BIT_MASK(i)) {
			env->catch_ctx[i].base = (prog_counter_t) mf_c_val(pop(env), ulong);
			env->catch_ctx[i].tos = (prog_counter_t) mf_c_val(pop(env), ulong);
			env->catch_ctx[i].pc = (prog_counter_t) mf_c_val(pop(env), ulong);
			mu_debug(MF_SOURCE_PROG, MU_DEBUG_TRACE9,
			      ("Pop Exception: %lu %lu -> pc=%lu, tos=%lu, base=%lu",
			       (unsigned long) i,
			       (unsigned long) TOS_INVARIANT(env,env->tos),
			       (unsigned long) env->catch_ctx[i].pc,
			       (unsigned long) env->catch_ctx[i].tos,
			       (unsigned long) env->catch_ctx[i].base));
		}
	} while (i > 0);
}

void
instr_adjust(eval_environ_t env)
{
	long nargs = mf_c_val(get_immediate(env, 0), long);
	if (PROG_TRACE_ENGINE)
		prog_trace(env, "ADJUST %ld", nargs);
	adjust_stack(env, nargs);
	advance_pc(env, 1);
}

void
instr_popreg(eval_environ_t env)
{
	env->reg = pop(env);
	if (PROG_TRACE_ENGINE)
		prog_trace(env, "POPREG %p", mf_c_val(env->reg, ptr));
}

void
instr_pushreg(eval_environ_t env)
{
	if (PROG_TRACE_ENGINE)
		prog_trace(env, "PUSHREG %p", mf_c_val(env->reg, ptr));
	push(env, env->reg);
}

void
instr_funcall(eval_environ_t env)
{
	const char *name;
	prog_counter_t pc = (prog_counter_t) mf_c_val(get_immediate(env, 1), ulong);
	get_literal(env, 0, &name);
	if (PROG_TRACE_ENGINE)
		prog_trace(env, "FUNCALL %s (%lu)", name, (unsigned long)pc);
	advance_pc(env, 2);
	env_make_frame(env);
	env->pc = pc-1;
}

void
dump_funcall(prog_counter_t i)
{
	printf("%s (%lu)",
	       (char*)(dataseg + mf_cell_c_value(prog[i], size)),
	       mf_cell_c_value(prog[i+1], ulong));
}

/* Opcode:

   xlat N OFF

   Synopsis:

   Scan the table until xI==REG is found or the table is exhausted.
   If found, replace REG with yI and return 0. Otherwise, return 1
*/
void
instr_xlat(eval_environ_t env)
{
	unsigned long i;
	unsigned long count = mf_c_val(get_immediate(env, 0), ulong);
	size_t off = mf_c_val(get_immediate(env, 1), size);
	STKVAL *tab = (STKVAL *) (env->dataseg + off);

        if (PROG_TRACE_ENGINE)
		prog_trace(env, "XLAT %lu %lu", count, (unsigned long) off);
	advance_pc(env, 2);
	for (i = 0; i < count; i += 2) {
		if (mf_c_val(tab[i], long) == mf_c_val(env->reg, long)) {
			env->reg = tab[i+1];
			push(env, (STKVAL)0);
			return;
		}
	}
	push(env, (STKVAL)1);
}

void
instr_xlats(eval_environ_t env)
{
	unsigned long i;
	unsigned long count = mf_c_val(get_immediate(env, 0), uint);
	size_t off = mf_c_val(get_immediate(env, 1), size);
	STKVAL *tab = (STKVAL *) (env->dataseg + off);
	char *str = (char*) env_data_ref(env, mf_c_val(env->reg, size));

        if (PROG_TRACE_ENGINE)
		prog_trace(env, "XLATS %lu %lu", count, (unsigned long) off);
	advance_pc(env, 2);
	for (i = 0; i < count; i += 2) {
		if (strcmp((char*)(env->dataseg + mf_c_val(tab[i], size)), str) == 0) {
			env->reg = tab[i+1];
			push(env, (STKVAL)0);
			return;
		}
	}
	push(env, (STKVAL)1);
}

void
dump_xlat(prog_counter_t i)
{
	unsigned long j;
	unsigned long count = mf_cell_c_value(prog[i], ulong);
	size_t off = mf_cell_c_value(prog[i+1], size);
	STKVAL *tab = (STKVAL *) (dataseg + off);

	printf("%lu %lu ", count, (unsigned long) off);
	for (j = 0; j < count; j += 2)
		printf("(%ld %ld) ", mf_c_val(tab[j], long), mf_c_val(tab[j+1], long));
}

void
dump_xlats(prog_counter_t i)
{
	unsigned long j;
	unsigned long count = mf_cell_c_value(prog[i], ulong);
	size_t off = mf_cell_c_value(prog[i+1], size);
	STKVAL *tab = (STKVAL *) (dataseg + off);

	printf("%lu %lu ", count, (unsigned long) off);

	for (j = 0; j < count; j += 2)
		printf("(%08lx %s %ld) ",
		       mf_c_val(tab[j], ulong),
		       (char*)(dataseg + mf_c_val(tab[j], size)),
		       mf_c_val(tab[j+1], long));
}

void
instr_jreg(eval_environ_t env)
{
	env->pc += (prog_counter_t)mf_c_val(env->reg, ulong) - 1;
	if (PROG_TRACE_ENGINE)
		prog_trace(env, "JREG %ld (%lu)",
			   (long)((prog_counter_t)mf_c_val(env->reg, ulong) - 1),
			   (unsigned long)env->pc);
}


static void
_dumper(prog_counter_t pc, struct optab *op, void *data)
{
	printf("%04lu: ", (unsigned long) pc);
	printf("%s ", op->name);
	if (op->dump)
		op->dump(pc + 1);
	putchar('\n');
}

void
dump_code(prog_counter_t start, prog_counter_t end)
{
	if (end == 0)
		end = pc;
	scan_code(start, end, _dumper, NULL);
}

static void
_fixup(prog_counter_t pc, struct optab *op, void *data)
{
	struct mu_locus_range *locus = data;
	enum instr_opcode opcode = (enum instr_opcode) mf_cell_c_value(prog[pc], int);
	prog[pc].c_instr = op->instr;
	if (opcode == opcode_regex) {
		int rc;
		size_t index = mf_cell_c_value(prog[pc+1], size);
		if (index > regcount) {
			parse_error_locus(locus,
					  "Invalid regexp index %lu",
					  (unsigned long) index);
			return;
		}
		rc = regcomp(&regtab[index].re,
			     (char*) (dataseg + regtab[index].expr),
				      regtab[index].regflags);
		if (rc) {
			char errbuf[512];
			regerror(rc, &regtab[index].re, errbuf, sizeof(errbuf));
			parse_error_locus(locus,
					  "Cannot compile regex: %s",
					  errbuf);
		} else
			regtab[index].compiled = 1;
	} else if (opcode == opcode_locus) {
		mu_locus_point_set_file(&locus->beg,
					(char*) (dataseg + mf_cell_c_value(prog[pc+1], size)));
		locus->beg.mu_line = mf_cell_c_value(prog[pc+2], size);
	}
}

void
fixup_code()
{
	struct mu_locus_range locus = MU_LOCUS_RANGE_INITIALIZER;
	scan_code(0, pc, _fixup, &locus);
	mu_locus_range_deinit(&locus);
	if (error_count)
		exit(EX_CONFIG);
}


void
env_init(eval_environ_t env)
{
	/* Initialize status and registers */
	env->status = SMFIS_CONTINUE;
	env->tos = datasize + env->stack_size - 1;
	env->base = 0;
	mf_c_val(env->reg, long) = 0; //FIXME

	env->matches = NULL;
	env->matchsize = 0;
	env->matchcount = 0;
	env->matchstr = 0;

	env->numautos = 0;

	/* Initialize catch functions */
	if (exception_count)
		memcpy(env->catch_ctx, env->defcatch_ctx,
		       exception_count * sizeof(env->catch_ctx[0]));

	env_final_gc(env);
}

/* Initialize the data segment and relocate string variables */
static void
init_dataseg(STKVAL *dseg, size_t count)
{
	memcpy(dseg, dataseg, count * sizeof dataseg[0]);
}

void
env_init_dataseg(eval_environ_t env)
{
	init_dataseg(env->dataseg, dvarsize);
}

void
env_make_frame0(eval_environ_t env)
{
	push(env, (STKVAL) 0);
	push(env, (STKVAL) (env->base - env->tos));
	env->base = env->tos;
}

void
env_make_frame(eval_environ_t env)
{
	push(env, (STKVAL) (env->pc + 1));
	push(env, (STKVAL) (env->base - env->tos));
	env->base = env->tos;
}

void
env_leave_frame(eval_environ_t env, int nargs)
{
	env->tos = env->base;
	env->base += (prog_counter_t) mf_c_val(pop(env), ulong) + 1;
	env->pc = (prog_counter_t) mf_c_val(pop(env), ulong);
	adjust_stack(env, nargs);
}

void
env_push_string(eval_environ_t env, char *arg)
{
	pushs(env, arg);
}

void
env_push_number(eval_environ_t env, long arg)
{
	push(env, (STKVAL) arg);
}

void
env_push_pointer(eval_environ_t env, void *arg)
{
	push(env, (STKVAL) arg);
}

int
eval_environment(eval_environ_t env, prog_counter_t start)
{
	if (setjmp(env->x_jmp))
		return 1;

	for (env->pc = start; ; env->pc++) {
		if (env->pc >= pc)
			runtime_error(env, _("pc out of range"));
		if (!mf_cell_instr(prog[env->pc]))
			break;
		if (setjmp(env->catch_jmp) == 0) {
			(*mf_cell_instr(prog[env->pc]))(env);
			env_unregister_autos(env);
		}
	}
	return 0;
}

static void
env_vsprintf_error(const char *fmt, va_list ap)
{
	mu_error(_("out of memory while formatting error message:"));
	mu_verror(fmt, ap);
}

size_t
env_vsprintf(eval_environ_t env, const char *biname,
	     const char *fmt, va_list ap)
{
	size_t n = 0, off;
	char *p, *s;

	while (1) {
		size_t k;
		size_t size;
		va_list apc;

		if (env->tos == env->toh)
			if (expand_dataseg(env, B2STACK(strlen(fmt)))) {
				env_vsprintf_error(fmt, ap);
				break;
			}

		size = (env->tos - env->toh - 1)
			        * sizeof env->dataseg[0];
		s = (char*) env_data_ref(env, env->toh);

		if (biname) {
			n = snprintf(s, size, "%s: ", biname);
			if (n >= size) {
				n += strlen(fmt); /* rough estimate */
				if (expand_dataseg(env, B2STACK(n))) {
					env_vsprintf_error(fmt, ap);
					break;
				}
				continue;
			}
		}
		va_copy(apc, ap);
		k = vsnprintf(s + n, size - n, fmt, apc);
		va_end(apc);
		if (k >= size) {
			if (expand_dataseg(env, B2STACK(k))) {
				env_vsprintf_error(fmt, ap);
				break;
			}
			continue;
		}
		n += k;
		break;
	}

	p = (char*) env_data_ref(env, off = heap_reserve(env, n + 1));
	memmove(p, s, n + 1);
	return off;
}

void
env_throw_0(eval_environ_t env, mf_exception status, size_t off)
{
	prog_counter_t pc;

	env_function_cleanup_flush(env, NULL);
	if (status > exception_count)
		runtime_error(env, _("unknown exception: %d: %s"),
			      status, (char*) env_data_ref(env, off));

	pc = env->catch_ctx[status].pc;
	if (pc) {
		/* Restore tos */
		env->tos = TOS_INVARIANT(env, env->catch_ctx[status].tos);
		env->base = TOS_INVARIANT(env, env->catch_ctx[status].base);
		/* Reset the exception to avoid recursion. */
		env->catch_ctx[status].pc = 0;
		/* Fixup the program counter */
		env->pc = pc - 1;
		/* Generate normal entry frame */
		push(env, (STKVAL) off);
		env_push_number(env, status);
		env_make_frame(env);
		longjmp(env->catch_jmp, 1);
	}
	runtime_error(env, _("uncaught exception %s: %s"),
		      mf_exception_str(status),
		      (char*) env_data_ref(env, off));
}

void
env_throw(eval_environ_t env, mf_exception status, const char *fmt, ...)
{
	va_list ap;
	size_t off;
	va_start(ap, fmt);
	off = env_vsprintf(env, NULL, fmt, ap);
	va_end(ap);
	env_throw_0(env, status, off);
}

void
env_throw_bi(eval_environ_t env, mf_exception status, const char *biname,
	     const char *fmt, ...)
{
	va_list ap;
	size_t off;
	va_start(ap, fmt);
	off = env_vsprintf(env, biname, fmt, ap);
	va_end(ap);
	env_throw_0(env, status, off);
}

sfsistat
environment_get_status(eval_environ_t env)
{
	return env->status;
}

SMFICTX *
env_get_context(eval_environ_t env)
{
	return env->ctx;
}

size_t
env_get_line_count(eval_environ_t env)
{
	return env->line_count;
}


/* Capturing support:

   Captured message is stored in env->stream. Before storing, any
   CRs (\r) are removed from the message. (FIXME: Actually, only
   those CRs should be removed that are followed by LF. However,
   that should not be a problem, since no CRs are allowed in RFC822
   messages, unless followed by LF. Anyway, I'll fix that soon.)

   The number of lines in stream is stored in env->line_count. It is
   used to produce correct message size for functions that need it,
   e.g. bi_sa.
 */
int
env_capture_start(eval_environ_t env)
{
	int rc;

	env->line_count = 0;
	if (env->stream) {
		/* Drop any previously captured message data */
		env_free_captured(env);
		mu_header_destroy(&env->header);
		/* Truncate existing stream and reposition to its
		   beginning */
		rc = mu_stream_truncate(env->stream, 0);
		if (rc == 0 &&
		    mu_stream_seek(env->stream, 0, SEEK_SET, NULL) == 0)
			return 0;

		/* If truncate fails, try to re-create the stream */
		mu_stream_close(env->stream);
		mu_stream_destroy(&env->stream);
	}
	env->reposition = 0;

	rc = mu_temp_file_stream_create(&env->stream, NULL, 0);
	if (rc) {
		mu_error(_("%scannot create temporary stream: %s"),
			 mailfromd_msgid(env->ctx), mu_strerror(rc));
		return 1;
	}
	return 0;
}

static void
env_capture_count_lines(eval_environ_t env, const char *buf, size_t size)
{
	while (size) {
		size_t len;
		const char *p = memchr(buf, '\n', size);
		if (p) {
			env->line_count++;
			len = p - buf + 1;
		} else
			len = size;
		buf += len;
		size -= len;
	}
}

/* FIXME: Use CRLF filter */
int
env_capture_write(eval_environ_t env, const char *buf, size_t size)
{
	int rc;

	if (!env->stream)
		return 1;

	if (env->reposition) {
		rc = mu_stream_seek(env->stream, 0, SEEK_END, NULL);
		if (rc) {
			mu_error(_("%stemporary stream seek failed: %s"),
				 mailfromd_msgid(env->ctx),
				 mu_strerror(rc));
			mu_stream_close(env->stream);
			mu_stream_destroy(&env->stream);
			return rc;
		}
		env->reposition = 0;
	}

	env_capture_count_lines(env, buf, size);
	while (size) {
		size_t len = mem_search(buf, '\r', size);
		rc = mu_stream_write(env->stream, buf, len, NULL);
		if (rc) {
			mu_error(_("%stemporary stream write failed: %s"),
				 mailfromd_msgid(env->ctx),
				 mu_strerror(rc));
			mu_stream_close(env->stream);
			mu_stream_destroy(&env->stream);
			return rc;
		}
		if (buf[len] == '\r')
			len++;
		buf += len;
		size -= len;
	}
	return 0;
}

int
env_capture_write_args(eval_environ_t env, ...)
{
	va_list ap;
	char *arg;
	int rc = 0;

	if (!env->stream)
		return 1;
	va_start(ap, env);
	while (arg = va_arg(ap, char*)) {
		if (rc = env_capture_write(env, arg, strlen(arg)))
			break;
	}
	va_end(ap);
	return rc;
}

int
env_get_header(eval_environ_t env, mu_header_t *hdr)
{
	if (!env->header) {
		char *text;
		int rc;
		mu_off_t size;
		size_t total;
		size_t start;

		rc = mu_stream_size(env->stream, &size);
		if (rc) {
			mu_diag_funcall(MU_DIAG_ERROR, "mu_stream_size", NULL,
					rc);
			return rc;
		}
		text = mu_alloc(size + 1);
		rc = mu_stream_seek(env->stream, 0, SEEK_SET, NULL);
		if (rc) {
			mu_diag_funcall(MU_DIAG_ERROR, "mu_stream_seek",
					NULL, rc);
			free(text);
			return rc;
		}

		/* FIXME: Use "header" filter instead of this loop */
		for (total = 0; total < size;) {
			size_t nrd;

			rc = mu_stream_read(env->stream, text + total,
					    size - total, &nrd);
			if (rc) {
				mu_diag_funcall(MU_DIAG_ERROR,
						"mu_stream_read",
						NULL, rc);
				free(text);
				return rc;
			}
			if (nrd == 0)
				break;
			total += nrd;
		}
		text[total] = 0;

               /* FIXME: Reposition the stream at its end.
		  This call may happen in the middle of capturing
		  so I have to make sure to not disturb the capturing
		  process.

		  The same effect could have been achieved by using
		  streamref, but this approach speeds up things a
		  bit.
	       */
		env_reposition(env);

		if (memcmp (text, "From ", 5) == 0)
			start = strcspn (text, "\n") + 1;
		else
			start = 0;
		rc = mu_header_create(&env->header, text + start,
				      total - start);
		free(text);
		if (rc) {
			mu_diag_funcall(MU_DIAG_ERROR, "mu_header_create",
					NULL, rc);
			return rc;
		}
	}
	*hdr = env->header;
	return 0;
}

/* MMQ */

void
env_msgmod_clear(eval_environ_t env)
{
	if (PROG_TRACE_ENGINE)
		prog_trace(env, "Clearing message modification queue");
	if (env->msgmod)
		env->msgmod(env->data, NULL);
	mu_list_clear(env->mmq);
}

void
destroy_msgmod_closure(void *item)
{
	struct msgmod_closure *cmd = item;
	free(cmd->name);
	free(cmd->value);
}

void
env_msgmod_append(eval_environ_t env, enum msgmod_opcode opcode,
		  const char *name, const char *value, unsigned idx)
{
	struct msgmod_closure *cp = mu_alloc(sizeof *cp);

	if (PROG_TRACE_ENGINE)
		prog_trace(env, "Registering %s \"%s\" \"%s\" %u",
			   msgmod_opcode_str(opcode), SP(name), SP(value),
			   idx);

	cp->opcode = opcode;
	cp->name = name ? mu_strdup(name) : NULL;
	cp->value = value ? mu_strdup(value) : NULL;
	cp->idx = idx;

	if (!env->mmq) {
		mu_list_create(&env->mmq);
		mu_list_set_destroy_item(env->mmq, destroy_msgmod_closure);
	}
	mu_debug(MF_SOURCE_ENGINE, MU_DEBUG_TRACE5,
		 ("adding msgmod_closure: %s \"%s\" %s %u",
		  msgmod_opcode_str(cp->opcode),
		  SP(cp->name), SP(cp->value), cp->idx));
	if (env->msgmod)
		env->msgmod(env->data, cp);
	mu_list_append(env->mmq, cp);
}

size_t
env_msgmod_count(eval_environ_t env)
{
	size_t n;
	if (!env->mmq)
		n = 0;
	else
		mu_list_count(env->mmq, &n);
	return n;
}

int
env_msgmod_apply(eval_environ_t env, mu_list_action_t fun, void *data)
{
	return mu_list_foreach(env->mmq, fun, data);
}


struct builtin_priv {  /* Built-in private data structure */
	void *(*init)();
	void (*destroy)(void*);
	int (*free_capture)(void*);
};

static size_t builtin_priv_size;
static size_t builtin_priv_count;
static struct builtin_priv *bi_priv;

static void
builtin_priv_destroy(void *ptr)
{
	free(ptr);
}

int
builtin_priv_register(void *(*init)(), void (*destroy)(void*),
		      void (*free_capture))
{
	struct builtin_priv *p;
	int desc;

	if (!init)
		return -1;
	if (builtin_priv_count == builtin_priv_size) {
		if (builtin_priv_size == 0)
			builtin_priv_size = 4;
		bi_priv = mu_2nrealloc(bi_priv, &builtin_priv_size,
				     sizeof bi_priv[0]);
	}
	desc = builtin_priv_count;
	p = bi_priv + builtin_priv_count++;
	p->init = init;
	p->destroy = destroy ? destroy : builtin_priv_destroy;
	p->free_capture = free_capture;
	return desc;
}

void
env_free_captured(eval_environ_t env)
{
	int i;

	if (!env->bi_priv_array)
		return;
	for (i = 0; i < builtin_priv_count; i++)
		if (bi_priv[i].free_capture && env->bi_priv_array[i])
			bi_priv[i].free_capture(env->bi_priv_array[i]);
}

void *
env_get_builtin_priv(eval_environ_t env, int id)
{
	if (id < 0 || id >= builtin_priv_count)
		runtime_error(env,
			      _("unknown built-in private data requested (%d)"),
			      id);
	if (!env->bi_priv_array) {
		if (builtin_priv_count == 0)
			runtime_error(env,
				      _("no built-in private data registered"));
		env->bi_priv_array = mu_calloc(builtin_priv_count,
					     sizeof env->bi_priv_array[0]);
	}
	if (env->bi_priv_array[id] == NULL) {
		env->bi_priv_array[id] = bi_priv[id].init();
		if (!env->bi_priv_array[id])
			runtime_error(env,
				      _("initial allocation for built-in "
				        "private data #%d failed"), id);
	}
	return env->bi_priv_array[id];
}

static void
env_builtin_priv_destroy(eval_environ_t env)
{
	if (env->bi_priv_array) {
		int i;
		for (i = 0; i < builtin_priv_count; i++)
			if (env->bi_priv_array[i])
				bi_priv[i].destroy(env->bi_priv_array[i]);
		free(env->bi_priv_array);
	}
}

eval_environ_t
create_environment(SMFICTX *ctx,
		   const char *(*getsym)(void *data, const char *str),
		   int (*setreply)(void *data, char *code, char *xcode,
				   char *message),
		   void (*msgmod)(void *data, struct msgmod_closure *cp),
		   void *data)
{
	struct eval_environ *env = calloc(1, sizeof *env);

	if (!env) {
		mu_error(_("not enough memory"));
		exit(1);
	}

	env->stack_size = stack_size;
	env->dataseg = calloc(stack_size + datasize, sizeof env->dataseg[0]);
	if (!env->dataseg) {
		mu_error(_("not enough memory"));
		exit(1);
	}

	init_dataseg(env->dataseg, datasize);

	env->ctx = ctx;
	env->data = data;
	env->getsym = getsym;
	env->setreply = setreply;
	env->msgmod = msgmod;
	env->status = SMFIS_CONTINUE;
	/* FIXME:
	   The only registers that we initialize here. The rest is initialized
	   in env_init. The top of heap should be retained across calls to
	   handlers, since we store string variables there. This raises stack
	   size requirements. */
	env->toh = datasize;
	env->tos = datasize + env->stack_size - 1;

	env->bi_priv_array = NULL;

	env_cleanup_list_create(&env->function_cleanup_list);
	env_cleanup_list_create(&env->environ_cleanup_list);

	if (exception_count) {
		env->defcatch_ctx = mu_zalloc(exception_count *
					      sizeof(env->defcatch_ctx[0]));
		env->catch_ctx = mu_zalloc(exception_count *
					   sizeof(env->catch_ctx[0]));
	}

	return env;
}

void
destroy_environment(eval_environ_t env)
{
	free(env->catch_ctx);
	free(env->defcatch_ctx);
	free(env->dataseg);
	free(env->matches);
	mu_stream_destroy(&env->stream);
	mu_header_destroy(&env->header);
	mu_list_destroy(&env->function_cleanup_list);
	mu_list_destroy(&env->environ_cleanup_list);
	mu_list_destroy(&env->mmq);
	env_builtin_priv_destroy(env);
	free(env);
}


struct entry_point {
	int ishandler;
	prog_counter_t pc;
	union {
		enum smtp_state tag;
		const char *name;
	} v;
};

struct enum_data {
	size_t i;
	struct module *mod;
	struct entry_point *base;
};

static int
function_counter(void *sym, void *data)
{
	struct function *fp = (struct function *)sym;
	struct enum_data *d = data;
	if (fp->sym.module == d->mod && fp->sym.alias == NULL)
		d->i++;
	return 0;
}

static int
function_lister(void *sym, void *data)
{
	struct function *f = sym;
	struct enum_data *d = data;

	if (f->sym.module == d->mod && f->sym.alias == NULL) {
		d->base[d->i].ishandler = 0;
		d->base[d->i].v.name = f->sym.name;
		d->base[d->i].pc = f->entry;
		d->i++;
	}
	return 0;
}

static int
comp_pc(const void *a, const void *b)
{
	const struct entry_point *ap = a;
	const struct entry_point *bp = b;

	if (ap->pc < bp->pc)
		return -1;
	else if (ap->pc > bp->pc)
		return 1;
	return 0;
}

static void
print_dataseg()
{
	char *p = (char*) dataseg;
	size_t s = datasize * sizeof(STKVAL);
	size_t off;

	printf("Data segment:\n");
	printf("-------------\n");

	for (off = 0; off < s; ) {
		char vbuf[GACOPYZ_VBUFSIZE];
		size_t rd = gacopyz_format_vbuf(vbuf, p + off, s - off);
		printf("%08lx: %s\n", (unsigned long) off, vbuf);
		off += rd;
	}
}

void
print_code()
{
	enum smtp_state tag;
	struct entry_point *ep; /* Entry points */
	size_t epcount = 0; /* Number of entry points */
	size_t i;
	struct enum_data d;
	struct module **modv;
	size_t modc;

	/* Get all modules */
	collect_modules(&modv, &modc);

	/* Count all available entry points: */
	d.i = 0;
	for (i = 0; i < modc; i++) {
		d.mod = modv[i];
		symtab_enumerate(MODULE_SYMTAB(modv[i], namespace_function),
				 function_counter, &d);
	}
	epcount = d.i;
	for (tag = smtp_state_first; tag < smtp_state_count; tag++)
		if (entry_point[tag])
			epcount++;

	ep = mu_alloc((epcount+1)*sizeof *ep);

        /* Fill in entry points array */
	i = 0;
	for (tag = smtp_state_first; tag < smtp_state_count; tag++)
		if (entry_point[tag]) {
			ep[i].ishandler = 1;
			ep[i].pc = entry_point[tag];
			ep[i].v.tag = tag;
			i++;
		}

	d.base = ep;
	d.i = i;
	for (i = 0; i < modc; i++) {
		d.mod = modv[i];
		symtab_enumerate(MODULE_SYMTAB(modv[i], namespace_function),
				 function_lister, &d);
	}

	/* Dispose of module vector */
	free (modv);

	/* Sort the array */
	qsort(ep, epcount, sizeof ep[0], comp_pc);
	ep[epcount].pc = pc;

	/* Actually print the code */

	for (i = 0; i < epcount; i++) {
		if (ep[i].ishandler)
			printf("HANDLER %s\n", state_to_string(ep[i].v.tag));
		else
			printf("FUNCTION %s\n", ep[i].v.name);
		dump_code(ep[i].pc, ep[i+1].pc);
	}
	free(ep);
	print_dataseg();
}


static eval_environ_t genv;
static size_t *s_off;
static size_t s_cnt;

static int
s_off_cmp(const void *a, const void *b)
{
	char *pa = mf_c_val(genv->dataseg[*(const size_t *) a], str);
	char *pb = mf_c_val(genv->dataseg[*(const size_t *) b], str);

	if (pa < pb)
		return -1;
	else if (pa > pb)
		return 1;
	return 1;
}

void
env_final_gc(eval_environ_t env)
{
	size_t i;
	size_t top = datasize;
	size_t bot = env->toh;

	genv = env;
	/* Prepare s_off/s_count: remove any variables that are not
	   in heap */
	s_off = mu_calloc(dataseg_reloc_count, sizeof s_off[0]);
	for (i = 0, s_cnt = 0; i < dataseg_reloc_count; i++) {
		size_t p = mf_c_val(env->dataseg[dataseg_reloc[i]], size);
		if (top <= p && p < bot)
			s_off[s_cnt++] = dataseg_reloc[i];
	}

	if (s_cnt) {
		qsort(s_off, s_cnt, sizeof s_off[0], s_off_cmp);

		/* Compact the variables */
		env->toh = datasize;
		for (i = 0; i < s_cnt; i++) {
			size_t off = s_off[i];
#define S_PTR ((char*) env_data_ref(env, mf_c_val(env->dataseg[off], size)))
			size_t len = strlen(S_PTR) + 1;
			size_t q = heap_reserve(env, len);
			memmove(env_data_ref(env, q), S_PTR, len);
			env->dataseg[off] = (STKVAL) q;
#undef S_PTR
		}
		free(s_off);
	}
}

void
env_save_catches(eval_environ_t env)
{
	memcpy(env->defcatch_ctx, env->catch_ctx,
	       exception_count * sizeof env->defcatch_ctx[0]);
}