~ubuntu-branches/debian/sid/mirrordir/sid

/* parse.c - simple C intepretor.
   This has nothing to do with cryptography.
   Copyright (C) 1998 Paul Sheer

   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 2 of the License, 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, write to the Free Software
   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
   02111-1307, USA.  
 */

#include "mostincludes.h"
#ifdef HAVE_SYS_WAIT_H
#include <sys/wait.h>
#endif
#include "huge-number.h"
#include "parse.h"
#include "diffie/compat.h"
#include "mad.h"

#ifdef HAVE_MAD
void mad_value_free (Value v, char *file, int line)
#define value_free(v) mad_value_free(v,__FILE__,__LINE__)
#else
static inline void value_free (Value v)
#endif
{
    if (v.type & VALUE_FREE) {
	switch (v.type & VALUE_TYPE) {
	case VALUE_STRING:
	    memset (v.v.s, 0, v.type & VALUE_LEN);
#ifdef HAVE_MAD
	    mad_free (v.v.s, file, line);
#else
	    free (v.v.s);
#endif
	    break;
	case VALUE_HUGE:
	    huge_free (v.v.h);
	    break;
	}
    }
}

void parser_value_free (Value v)
{
    value_free (v);
}

#ifdef HAVE_MAD
#define value_dup(v) mad_value_dup(v,__FILE__,__LINE__)
static inline Value mad_value_dup (Value v, char *file, int line)
#else
static inline Value value_dup (Value v)
#endif
{
    Value n;
    n = v;
    if (!(n.type & VALUE_POINTER)) {
	switch (n.type & VALUE_TYPE) {
	case VALUE_STRING:
	    n.type |= VALUE_FREE;
#ifdef HAVE_MAD
	    n.v.s = mad_alloc ((n.type & VALUE_LEN) + 1, file, line);
#else
	    n.v.s = malloc ((n.type & VALUE_LEN) + 1);
#endif
	    memcpy (n.v.s, v.v.s, n.type & VALUE_LEN);
	    n.v.s[n.type & VALUE_LEN] = '\0';
	    break;
	case VALUE_HUGE:
	    n.type |= VALUE_FREE;
	    n.v.h = huge_dup (n.v.h);
	    break;
	}
    }
    return n;
}

#define whole(x) \
    (((x) >= 'a' && (x) <= 'z') || ((x) >= 'A' && (x) <= 'Z') || (x) == '_')

#define digit(x) \
    ((x) >= '0' && (x) <= '9')

typedef struct op_stack {
    Operator *op;
    Value **variable;
    int line;
    struct op_stack *next;
    struct op_stack *prev;
    struct op_stack *branch;
} OpStack;

typedef struct op_list {
    Operator *op;
    int line;
    struct op_list *next;
} OpList;

void parser_error (char *s, OpList * op)
{
    if (op)
	fprintf (stderr, "%d: %s: %s\n", op->line, s, op->op->s);
    else
	fprintf (stderr, "%s\n", s);
}

void runtime_error (char *s, OpStack * op)
{
    if (op)
	fprintf (stderr, "%d: runtime error: %s: %s\n", op->line, s, op->op->s);
    else
	fprintf (stderr, "%s\n", s);
}

void preparser_error (char *s, char *t, int line)
{
    fprintf (stderr, "%d: %s: %.15s...\n", line, s, t);
}

#define CHECK_ARG(v,t)				\
    if (!(v.type & t)) {			\
	runtime_error ("bad arg type", *op);	\
	return 1;				\
    }

#define STACK_PUSH(o,s,p) 		\
    {					\
	o *t;				\
	t = malloc (sizeof (o));	\
	memset (t, 0, sizeof (o));	\
	t->p = p;			\
	t->next = *s;			\
	*s = t;				\
    }


#define STACK_POP(o,s,p) 		\
    {					\
	p = (*s)->p;			\
	if ((*s)->next) {		\
	    o *t;			\
	    t = (*s)->next;		\
	    free (*s);			\
	    *s = t;			\
	} else {			\
	    free (*s);			\
	    *s = 0;			\
	}				\
    }

#define STACK_FREE(s,f)			\
    {					\
	while (s) {			\
	    void *__my_temp = s;	\
	    s = s->next;		\
	    f (__my_temp);		\
	}				\
    }

void op_free (Operator * op)
{
    if (op) {
	if (op->value) {
	    value_free (*op->value);
	    memset (op->value, 0, sizeof (Value));
	    free (op->value);
	}
	memset (op, 0, sizeof (*op));
	free (op);
    }
}

void opstack_free (OpStack * s)
{
    if (s) {
	op_free (s->op);
	memset (s, 0, sizeof (*s));
	free (s);
    }
}

#ifdef HAVE_MAD
#define op_dup(o) mad_op_dup(o,__FILE__,__LINE__)
Operator *mad_op_dup (Operator * op, char *file, int line)
#else
Operator *op_dup (Operator * op)
#endif
{
    Operator *o;
#ifdef HAVE_MAD
    o = mad_alloc (sizeof (Operator), file, line);
#else
    o = malloc (sizeof (Operator));
#endif
    *o = *op;
    if (op->value) {
#ifdef HAVE_MAD
	o->value = mad_alloc (sizeof (Value), file, line);
#else
	o->value = malloc (sizeof (Value));
#endif
	*o->value = value_dup (*op->value);
    }
    return o;
}

#ifdef HAVE_MAD
#define op_push(s,o,l) mad_op_push(s,o,l,__FILE__,__LINE__)
static inline void mad_op_push (OpStack ** s, Operator * o, int l, char *file, int line)
#else
static inline void op_push (OpStack ** s, Operator * o, int l)
#endif
{
    Operator *op;
#ifdef HAVE_MAD
    op = mad_op_dup (o, file, line);
#else
    op = op_dup (o);
#endif
    STACK_PUSH (OpStack, s, op);
    (*s)->line = l;
}

static inline Operator *op_pop (OpStack ** s)
{
    Operator *op;
    if (!*s)
	return 0;
    STACK_POP (OpStack, s, op);
    return op;
}


#ifdef HAVE_MAD
#define value_push(s,o) mad_value_push(s,o,__FILE__,__LINE__)
static inline void mad_value_push (ValueStack ** s, Value value, char *file, int line)
#else
static inline void value_push (ValueStack ** s, Value value)
#endif
{
#ifdef HAVE_MAD
    ValueStack *t;
    t = mad_alloc (sizeof (ValueStack), file, line);
    memset (t, 0, sizeof (ValueStack));
    t->value = value;
    t->next = *s;
    *s = t;
#else
    STACK_PUSH (ValueStack, s, value);
#endif
}

void parser_value_push (ValueStack ** s, Value value)
{
    value_push (s, value);
}

static inline Value value_pop (ValueStack ** s)
{
    Value value;
    if (!*s) {
	parser_error ("popping off enpty stack???", 0);
	value.type = 0;
	value.v.s = 0;
	return value;
    }
    STACK_POP (ValueStack, s, value);
    return value;
}

Value parser_value_pop (ValueStack ** s)
{
    return value_pop (s);
}

static inline void push_string_free (ValueStack ** s, char *str, int len)
{
    Value value;
    value.type = VALUE_STRING | VALUE_FREE | (len & VALUE_LEN);
    value.v.s = str;
    value_push (s, value);
}

static inline void push_huge_free (ValueStack ** s, Huge * v)
{
    Value value;
    value.type = VALUE_HUGE | VALUE_FREE;
    value.v.h = v;
    value_push (s, value);
}

void parser_push_huge_free (ValueStack ** s, Huge * v)
{
    push_huge_free (s, v);
}

static inline void push_string (ValueStack ** s, char *str, int len)
{
    Value value;
    value.type = VALUE_STRING | (len & VALUE_LEN);
    value.v.s = str;
    value_push (s, value);
}

void parser_push_string (ValueStack ** s, char *str, int len)
{
    push_string (s, str, len);
}

void parser_push_string_free (ValueStack ** s, char *str, int len)
{
    push_string_free (s, str, len);
}

static inline void push_int (ValueStack ** s, long i)
{
    Value value;
    value.type = VALUE_LONG;
    value.v.i = i;
    value_push (s, value);
}

void parser_push_int (ValueStack ** s, long i)
{
    push_int (s, i);
}

static int oper_pop (OpStack ** op, ValueStack ** v)
{
    Value value;
    value = value_pop (v);
    value_free (value);
    return 0;
}

static int op_neg (OpStack ** op, ValueStack ** v)
{
    if ((*v)->value.type & VALUE_LONG) {
	(*v)->value.v.i = -(*v)->value.v.i;
    } else {
	Value value;
	value = value_pop (v);
	push_huge_free (v, huge_neg (value.v.h));
	value_free (value);
    }
    return 0;
}

static int op_lognot (OpStack ** op, ValueStack ** v)
{
    if ((*v)->value.type & VALUE_LONG) {
	(*v)->value.v.i = !(*v)->value.v.i;
    } else {
	Value value;
	value = value_pop (v);
	push_int (v, (long) !huge_nonzero (value.v.h));
	value_free (value);
    }
    return 0;
}

/* pointer and array functions */
static int op_pointer (OpStack ** op, ValueStack ** v)
{
    if (((*v)->value.type & VALUE_POINTER)) {
/* lcc 4.1 has a bug */
	int type = VALUE_P0;
	(*v)->value.v.i = *(*v)->value.v.p;
	(*v)->value.type -= type;
    } else if (((*v)->value.type & VALUE_STRING)) {
	Value value1;
	value1 = value_pop (v);
	push_int (v, (long) ((unsigned char) *value1.v.s));
	value_free (value1);
    } else {
	runtime_error ("bad arg type", *op);
	return 1;
    }
/*    value_free (value); */
    return 0;
}

static int op_array (OpStack ** op, ValueStack ** v)
{
    Value value2;
    value2 = value_pop (v);
    if (((*v)->value.type & VALUE_POINTER)) {
	int type = VALUE_P0;
	(*v)->value.v.i = (*v)->value.v.p[value2.v.i];
	(*v)->value.type -= type;
    } else if (((*v)->value.type & VALUE_STRING)) {
	Value value1;
	value1 = value_pop (v);
	push_int (v, (long) ((unsigned char) value1.v.s[value2.v.i]));
	value_free (value1);
    } else {
	runtime_error ("bad arg type", *op);
	return 1;
    }
/*    value_free (value); */
    return 0;
}

/* to convert a variable into a value, just derefernce it */
static int op_variable (OpStack ** op, ValueStack ** v)
{
    Value value;
    int type = VALUE_P0;
    Value *p;
    value = *(*op)->op->value;
    p = (Value *) value.v.p;
    value.v.i = (long) *value.v.p;
    value.type -= type;
    if (value.type & VALUE_STRING) {
	value.type |= p->type & VALUE_LEN;
	value.type &= ~(VALUE_FREE);
	value_push (v, value);
    } else
	value_push (v, value_dup (value));
    return 0;
}

/* = assignment operator
 * Two kinds:
 *    = *     is from `*x = 2'
 *    = [     is from `x[3] = 4'
 *    `x = 2' is translated into the first type by the compiler
 *
 */
static int op_assign (OpStack ** op, ValueStack ** v)
{
    Value value1, value2, value3;
    Value *p;
    if (*(*op)->next->op->s == '[') {
	value3 = value_pop (v);
	value2 = value_pop (v);
	value1 = value_pop (v);
	if ((value1.type & VALUE_STRING))
	    value1.v.s[value2.v.i] = (char) value3.v.i;
	else
	    value1.v.p[value2.v.i] = value3.v.i;
    } else {
	value2 = value_pop (v);
	value1 = value_pop (v);
	if ((value1.type & VALUE_HUGE) && (value2.type & VALUE_LONG)) {
	    value2.v.h = huge_from_long (value2.v.i);
	    value2.type = VALUE_HUGE | VALUE_FREE;
	}
	if ((value2.type & VALUE_STRING) && !(value2.type & VALUE_FREE)) {
	    value_free (*((Value *) value1.v.p));
	    p = (Value *) value1.v.p;
	    *p = value2;
	} else {
	    value_free (*((Value *) value1.v.p));
	    p = (Value *) value1.v.p;
	    *p = value_dup (value2);
	}
    }
    value_push (v, value2);
    *op = (*op)->next;
    return 0;
}

static int op_swap (OpStack ** op, ValueStack ** v)
{
    long t;
    ValueStack *x;
    t = *(*v)->value.v.p;
    *(*v)->value.v.p = *(*v)->next->value.v.p;
    *(*v)->next->value.v.p = t;
    x = *v;
    (*v) = (*v)->next;
    free (x);
    return 0;
}

static int op_memxor (OpStack ** op, ValueStack ** v)
{
    long t;
    char *s;
    int i;
    ValueStack *x;
    i = (*v)->value.v.i;
    t = (*v)->next->value.v.i;
    s = (*v)->next->next->value.v.s;
    if (i > 0)
	*s++ ^= (char) (t);
    if (i > 1)
	*s++ ^= (char) (t >>= 8);
    if (i > 2)
	*s++ ^= (char) (t >>= 8);
    if (i > 3)
	*s ^= (char) (t);
    x = *v;
    (*v) = (*v)->next->next;
    free (x->next);
    free (x);
    return 0;
}

static int op_malloc (OpStack ** op, ValueStack ** v)
{
    Value value1, value2;
    value1 = value_pop (v);
    value2.type = VALUE_LONG | VALUE_P0;
    value2.v.p = malloc (value1.v.i);
    value_push (v, value2);
    value_free (value1);
    return 0;
}

static int op_mfree (OpStack ** op, ValueStack ** v)
{
    Value value;
    value = value_pop (v);
    if (value.v.p)
	free (value.v.p);
    value_free (value);
    push_int (v, 0);
    return 0;
}

static int op_atoh (OpStack ** op, ValueStack ** v)
{
    Value value1, value2;
    value2 = value_pop (v);
    value1 = value_pop (v);
    CHECK_ARG (value2, VALUE_LONG);
    CHECK_ARG (value1, VALUE_STRING);
    push_huge_free (v, huge_from_string (value1.v.s, 0, value2.v.i));
    value_free (value1);
    value_free (value2);
    return 0;
}

#define OP_VARIABLE	3

#if 0
/* to convert a variable into a value, just derefernce it */
static int op_address (OpStack ** op, ValueStack ** v)
{
    Value value;
    if (*(*op)->next->op->s == '[') {
	value = value_pop (v);
	(*v)->value.v.p += value.v.i;
    } else if (*(*op)->next->op->s != '*') {
	runtime_error ("cannot address a constant", *op);
	return 1;
    }
    *op = (*op)->next;
    return 0;
}
#endif

static int op_plus (OpStack ** op, ValueStack ** v)
{
    Value value1, value2;
    value2 = value_pop (v);
    value1 = value_pop (v);
    if ((value2.type == VALUE_LONG) && (value1.type & VALUE_POINTER)) {
	value1.v.p += value2.v.i;
	value_push (v, value1);
    } else if ((value2.type & VALUE_LONG) && (value1.type & VALUE_HUGE)) {
	Huge *r, *b;
	b = huge_from_long (value2.v.i);
	r = huge_add (value1.v.h, b);
	huge_free (b);
	push_huge_free (v, r);
    } else if ((value2.type & VALUE_HUGE) && (value1.type & VALUE_HUGE)) {
	Huge *r;
	r = huge_add (value1.v.h, value2.v.h);
	push_huge_free (v, r);
    } else if ((value2.type == VALUE_LONG) && (value1.type & VALUE_STRING)) {
	if (value2.v.i > (value1.type & VALUE_LEN))
	    push_string (v, "", 0);
	else if (value1.type & VALUE_FREE) {
	    char *p;
	    int l;
	    l = (value1.type & VALUE_LEN) - value2.v.i;
	    p = malloc (l + 1);
	    memcpy (p, value1.v.s + value2.v.i, l);
	    p[l] = '\0';
	    push_string_free (v, p, l);
	} else {
	    push_string (v, value1.v.s + value2.v.i, (value1.type & VALUE_LEN) - value2.v.i);
	}
    } else if ((value2.type & VALUE_STRING) && (value1.type & VALUE_STRING)) {
	char *p;
	int l;
	l = (value1.type & VALUE_LEN) + (value2.type & VALUE_LEN);
	p = malloc (l + 1);
	memcpy (p, value1.v.s, value1.type & VALUE_LEN);
	memcpy (p + (value1.type & VALUE_LEN), value2.v.s, value2.type & VALUE_LEN);
	p[l] = '\0';
	push_string_free (v, p, l);
    } else if ((value2.type == VALUE_LONG) && (value1.type == VALUE_LONG)) {
	push_int (v, value1.v.i + value2.v.i);
    } else {
	runtime_error ("bad arg type", *op);
    }
    value_free (value1);
    value_free (value2);
    return 0;
}

#define FUNC_BINARY(x,c,o,res,n,q)					\
    static int x (OpStack ** op, ValueStack ** v)			\
    {									\
	if ((*v)->value.type == VALUE_LONG				\
		    && (*v)->next->value.type  == VALUE_LONG) {		\
	    ValueStack *t;						\
	    (*v)->next->value.v.i = 					\
		(((*v)->next->value.v.i) o ((*v)->value.v.i));		\
	    t = *v;							\
	    (*v) = (*v)->next;						\
	    free (t);							\
	    return 0;							\
	} else {							\
	    Value a, b;							\
	    b = value_pop (v);						\
	    a = value_pop (v);						\
	    CHECK_ARG(a, VALUE_HUGE);					\
	    if (q == VALUE_HUGE)					\
		if (b.type & VALUE_LONG) {				\
		    b.v.h = huge_from_long (b.v.i);			\
		    b.type = VALUE_HUGE | VALUE_FREE;			\
		}							\
	    res (v, c (a.v.h, b.v.n));					\
	    value_free (a);						\
	    value_free (b);						\
	}								\
	return 0;							\
    }


static long huge_both (Huge * a, Huge * b)
{
    return (a->size && b->size);
}

static long huge_either (Huge * a, Huge * b)
{
    return (a->size || b->size);
}

FUNC_BINARY (op_minus, huge_sub, -, push_huge_free, h, VALUE_HUGE)
FUNC_BINARY (op_times, huge_mul, *, push_huge_free, h, VALUE_HUGE)
FUNC_BINARY (op_divide, huge_div, /, push_huge_free, h, VALUE_HUGE)
FUNC_BINARY (op_mod, huge_mod, %, push_huge_free, h, VALUE_HUGE)
FUNC_BINARY (op_logand, huge_and, &, push_huge_free, h, VALUE_HUGE)
FUNC_BINARY (op_logxor, huge_xor, ^, push_huge_free, h, VALUE_HUGE)
FUNC_BINARY (op_logor, huge_or, |, push_huge_free, h, VALUE_HUGE)
FUNC_BINARY (op_ge, 0 <= huge_compare, >=, push_int, h, VALUE_HUGE)
FUNC_BINARY (op_le, 0 >= huge_compare, <=, push_int, h, VALUE_HUGE)
FUNC_BINARY (op_gt, 0 < huge_compare, >, push_int, h, VALUE_HUGE)
FUNC_BINARY (op_lt, 0 > huge_compare, <, push_int, h, VALUE_HUGE)
FUNC_BINARY (op_notequal, huge_compare, !=, push_int, h, VALUE_HUGE)
FUNC_BINARY (op_equal, !huge_compare, ==, push_int, h, VALUE_HUGE)
FUNC_BINARY (op_and, huge_both, &&, push_int, h, VALUE_HUGE)
FUNC_BINARY (op_or, huge_either, ||, push_int, h, VALUE_HUGE)
FUNC_BINARY (op_left_sh, huge_lshift, <<, push_huge_free, i, VALUE_LONG)
FUNC_BINARY (op_right_sh, huge_rshift, >>, push_huge_free, i, VALUE_LONG)

static int op_powmod (OpStack ** op, ValueStack ** v)
{
    Value value1, value2, value3;
    value3 = value_pop (v);
    value2 = value_pop (v);
    value1 = value_pop (v);
    CHECK_ARG (value1, VALUE_HUGE);
    CHECK_ARG (value2, VALUE_HUGE);
    CHECK_ARG (value3, VALUE_HUGE);
    push_huge_free (v, huge_powmod (value1.v.h, value2.v.h, value3.v.h));
    value_free (value1);
    value_free (value2);
    value_free (value3);
    return 0;
}

static int op_pow (OpStack ** op, ValueStack ** v)
{
    Value value1, value2;
    Huge *a = 0, *b = 0;
    value2 = value_pop (v);
    value1 = value_pop (v);
    if (value1.type & VALUE_LONG)
	a = huge_from_long (value1.v.i);
    if (value2.type & VALUE_LONG)
	b = huge_from_long (value2.v.i);
    push_huge_free (v, huge_pow (a ? a : value1.v.h, b ? b : value2.v.h));
    value_free (value1);
    value_free (value2);
    huge_free (a);
    huge_free (b);
    return 0;
}

static int op_format (OpStack ** op, ValueStack ** v)
{
    Value value1, value2;
    char *p;
    value2 = value_pop (v);
    value1 = value_pop (v);
    CHECK_ARG (value1, VALUE_HUGE);
    CHECK_ARG (value2, VALUE_LONG);
    p = huge_format (value1.v.h, value2.v.i);
    push_string_free (v, p, strlen (p));
    value_free (value1);
    value_free (value2);
    return 0;
}

static int op_depth (OpStack ** op, ValueStack ** v)
{
    Value value;
    char *p;
    int depth;
    value = value_pop (v);
    CHECK_ARG (value, VALUE_STRING);
    for (depth = 0, p = value.v.s; *p; p++)
	if (*p == PATH_SEP)
	    depth++;
    push_int (v, depth - 1);
    value_free (value);
    return 0;
}

static int op_exit (OpStack ** op, ValueStack ** v)
{
    Value value;
    value = value_pop (v);
    CHECK_ARG (value, VALUE_LONG);
    exit (value.v.i);
    return 0;
}

static int op_strlen (OpStack ** op, ValueStack ** v)
{
    Value value1;
    value1 = value_pop (v);
    CHECK_ARG (value1, VALUE_STRING);
    push_int (v, value1.type & VALUE_LEN);
    value_free (value1);
    return 0;
}

static int op_strcat (OpStack ** op, ValueStack ** v)
{
    Value value1, value2;
    char *p;
    int l;
    value2 = value_pop (v);
    value1 = value_pop (v);
    CHECK_ARG (value1, VALUE_STRING);
    CHECK_ARG (value2, VALUE_STRING);
    l = (value1.type & VALUE_LEN) + (value2.type & VALUE_LEN);
    p = malloc (l + 1);
    memcpy (p, value1.v.s, value1.type & VALUE_LEN);
    memcpy (p + (value1.type & VALUE_LEN), value2.v.s, value2.type & VALUE_LEN);
    p[l] = '\0';
    push_string_free (v, p, l);
    value_free (value1);
    value_free (value2);
    return 0;
}

static int op_strstr (OpStack ** op, ValueStack ** v)
{
    char *p;
    Value value1, value2;
    value2 = value_pop (v);
    value1 = value_pop (v);
    CHECK_ARG (value1, VALUE_STRING);
    CHECK_ARG (value2, VALUE_STRING);
    p = strstr (value1.v.s, value2.v.s);
    if (p)
	push_string_free (v, (char *) strdup (p), strlen (p));	/* FIXME: cannot handle strings with nulls in them */
    else
	push_int (v, 0);
    value_free (value1);
    value_free (value2);
    return 0;
}

static int op_strcmp (OpStack ** op, ValueStack ** v)
{
    Value value1, value2;
    value2 = value_pop (v);
    value1 = value_pop (v);
    CHECK_ARG (value1, VALUE_STRING);
    CHECK_ARG (value2, VALUE_STRING);
    if (value1.v.s && value2.v.s)
	push_int (v, strcmp (value1.v.s, value2.v.s));
    else
	push_int (v, (unsigned long) value1.v.s > (unsigned long) value2.v.s ? 1 : ((unsigned long) value1.v.s < (unsigned long) value2.v.s ? -1 : 0));
    value_free (value1);
    value_free (value2);
    return 0;
}

static int op_strncmp (OpStack ** op, ValueStack ** v)
{
    Value value1, value2, value3;
    value3 = value_pop (v);
    value2 = value_pop (v);
    value1 = value_pop (v);
    CHECK_ARG (value1, VALUE_STRING);
    CHECK_ARG (value2, VALUE_STRING);
    CHECK_ARG (value3, VALUE_LONG);
    if (value1.v.s && value2.v.s)
	push_int (v, strncmp (value1.v.s, value2.v.s, value3.v.i));
    else
	push_int (v, (unsigned long) value1.v.s > (unsigned long) value2.v.s ? 1 : ((unsigned long) value1.v.s < (unsigned long) value2.v.s ? -1 : 0));
    value_free (value1);
    value_free (value2);
    value_free (value3);
    return 0;
}

static int op_if (OpStack ** op, ValueStack ** v)
{
    Value value;
    value = value_pop (v);
#if 0
    CHECK_ARG (value, VALUE_LONG);
#endif
    if (!value.v.i)
	*op = (*op)->branch;
    value_free (value);
    return 0;
}

static int op_goto (OpStack ** op, ValueStack ** v)
{
    *op = (*op)->branch;
    return 0;
}

static int op_value (OpStack ** op, ValueStack ** v)
{
    value_push (v, value_dup (*(*op)->op->value));
    return 0;
}

static int op_endvarargs (OpStack ** op, ValueStack ** v)
{
    Value value;
    value.type = VALUE_ENDVARARGS;
    value_push (v, value);
    return 0;
}

static int op_nop (OpStack ** op, ValueStack ** v)
{
    return 0;
}

/* simple way to do something that might otherwise be very complicated */
static int op_printf (OpStack ** op, ValueStack ** v)
{
    Value *b, value[128];
    int i, r;
    for (i = 63; i >= 0; i--) {
	value[i] = value_pop (v);
	if (value[i].type & VALUE_ENDVARARGS)
	    break;
    }
    b = value + i + 1;
    r = printf ((char *) b[0].v.s, b[1].v.s, b[2].v.s, b[3].v.s, b[4].v.s, b[5].v.s, b[6].v.s, b[7].v.s, b[8].v.s, b[9].v.s,
		b[10].v.s, b[11].v.s, b[12].v.s, b[13].v.s, b[14].v.s, b[15].v.s, b[16].v.s, b[17].v.s, b[18].v.s, b[19].v.s,
		b[20].v.s, b[21].v.s, b[22].v.s, b[23].v.s, b[24].v.s, b[25].v.s, b[26].v.s, b[27].v.s, b[28].v.s, b[29].v.s,
		b[30].v.s, b[31].v.s, b[32].v.s, b[33].v.s, b[34].v.s, b[35].v.s, b[36].v.s, b[37].v.s, b[38].v.s, b[39].v.s,
		b[40].v.s, b[41].v.s, b[42].v.s, b[43].v.s, b[44].v.s, b[45].v.s, b[46].v.s, b[47].v.s, b[48].v.s, b[49].v.s,
		b[50].v.s, b[51].v.s, b[52].v.s, b[53].v.s, b[54].v.s, b[55].v.s, b[56].v.s, b[57].v.s, b[58].v.s, b[59].v.s,
		b[60].v.s, b[61].v.s, b[62].v.s, b[63].v.s);
    for (; i <= 63; i++)
	value_free (value[i]);
    push_int (v, r);
    return 0;
}

/* simple way to do something that might otherwise be very complicated */
static int op_fflush (OpStack ** op, ValueStack ** v)
{
    fflush (stdout);
    push_int (v, 0);
    return 0;
}

static int my_exec (char *argv[])
{
    int r;
    pid_t pid;
    if (!argv)
	return -1;
    if (!argv[0])
	return -1;
    pid = fork ();
    if (pid < 0) {
	perror ("runtime error: fork() failed");
	return -1;
    }
    if (!pid) {
	execvp (argv[0], argv);
	perror ("runtime error: exec() or system() failed");
	exit (127);
    } else if (pid < (pid_t) 0) {
	r = -1;
    } else if (waitpid ((pid_t) pid, (int *) &r, (int) 0) != pid)
	r = -1;
    if (WIFEXITED (r))
	return WEXITSTATUS (r);
    return -1;
}

static int my_system (char *command)
{
    char *argv[4];
    argv[0] = "/bin/sh";
    argv[1] = "-c";
    argv[2] = command;
    argv[3] = 0;
    return my_exec (argv);
}

static int op_popen (OpStack ** op, ValueStack ** v)
{
    Value value;
    FILE *p;
    char *d = 0;
    long size = 1024, upto = 0;
    value = value_pop (v);
    CHECK_ARG (value, VALUE_STRING);
    p = (FILE *) popen (value.v.s, "r");
    value_free (value);
    if (!p) {
	runtime_error ("popen failed", *op);
	return 1;
    }
    d = malloc (size + 1);
    for (;;) {
	char *t;
	int count;
	count = fread (d + upto, 1, size - upto, p);
	upto += count;
	if (count < size - upto)
	    break;
	t = malloc ((size << 1) + 1);
	memcpy (t, d, size);
	free (d);
	d = t;
	size <<= 1;
    }
    d[upto] = '\0';
    pclose ((FILE *) p);
    push_string_free (v, d, upto);
    return 0;
}

static int op_system (OpStack ** op, ValueStack ** v)
{
    Value value;
    value = value_pop (v);
    CHECK_ARG (value, VALUE_STRING);
    push_int (v, my_system (value.v.s));
    value_free (value);
    return 0;
}

static int op_inc_mod (OpStack ** op, ValueStack ** v)
{
    Value value;
    value = value_pop (v);
    *(*v)->value.v.p = (*(*v)->value.v.p + 1) & value.v.i;
    return 0;
}

static int op_add_mod (OpStack ** op, ValueStack ** v)
{
    Value value1, value2;
    value2 = value_pop (v);
    value1 = value_pop (v);
    *(*v)->value.v.p = (*(*v)->value.v.p + value1.v.i) & value2.v.i;
/* value free */
    return 0;
}

static int op_exec (OpStack ** op, ValueStack ** v)
{
    Value value;
    char *b[64];
    int i, r;
    b[63] = 0;
    for (i = 62; i >= 0; i--) {
	value = value_pop (v);
	if (!(value.type & VALUE_ENDVARARGS)) {
	    CHECK_ARG (value, VALUE_STRING);
	    b[i] = (char *) strdup (value.v.s);
	}
	value_free (value);
	if (value.type & VALUE_ENDVARARGS)
	    break;
    }
    ++i;
    r = my_exec (b + i);
    for (; i < 63; i++)
	free (b[i]);
    push_int (v, r);
    return 0;
}

static Operator operators[] =
{

/* internal */
#define OP_NOOP		0
    {0, "__noop__", 0, OP_NOOP, 1, (Func) op_nop, 0, 0},
#define OP_POP		1
    {0, "__pop__", 0, OP_POP, 1, (Func) oper_pop, 0, 0},
#define OP_VALUE	2
/* just pushes a value onto the stack */
    {0, "__value__", 0, OP_VALUE, 1, (Func) op_value, 0, 0},
/* #define OP_VARIABLE  3  defined above */
/* just pushes a value onto the stack */
    {0, "__variable__", 0, OP_VARIABLE, 1, (Func) op_variable, 0, 0},
#define OP_ENDVARARGS	4
/* ends variable list of arguments */
  {0, "__endvarargs__", 0, OP_ENDVARARGS, 1, (Func) op_endvarargs, 0, 0},
#define OP_GOTO		5
    {0, "__goto__", 0, OP_GOTO, 1, (Func) op_goto, 0, 0},

#define OP_BINARY	30
/* must go before other * functions to avoid mistaking as two *'s */
    {0, "**", 16, OP_BINARY, 0, (Func) op_pow, 0, 0},
#define OP_UNARY	31

#define OP_POINTER	7
/* put these here, because we need to index unary * */
    {0, "*", 18, OP_UNARY, 0, (Func) op_pointer, 0, 0},
    {0, "*", 16, OP_BINARY, 0, (Func) op_times, 0, 0},

/* flow control */
#define OP_BLOCK_OPEN	10
#define OP_BLOCK_CLOSE	11
#define OP_IF		12
#define OP_ELSE		13
#define OP_EXPR_OPEN	14
#define OP_EXPR_CLOSE	(OP_EXPR_OPEN + 1)
#define OP_ARRAY_OPEN	16
#define OP_ARRAY_CLOSE	(OP_ARRAY_OPEN + 1)
#define OP_SEMICOLON	18
#define OP_COMMA	19
#define OP_RETURN	20
#define OP_WHILE	21
    {0, "{", 0, OP_BLOCK_OPEN, 0, 0, 0, 0},
    {0, "}", 0, OP_BLOCK_CLOSE, 0, 0, 0, 0},
    {0, "if", 0, OP_IF, 1, (Func) op_if, 0, 0},
    {0, "else", 0, OP_ELSE, 1, 0, 0, 0},
    {0, "(", 0, OP_EXPR_OPEN, 0, 0, 0, 0},
    {0, ")", 0, OP_EXPR_CLOSE, 0, 0, 0, 0},
    {0, "[", 19, OP_ARRAY_OPEN, 0, (Func) op_array, 0, 0},	/* works as a bracket as well as a binary operator */
    {0, "]", 0, OP_ARRAY_CLOSE, 0, 0, 0, 0},
    {0, ";", 0, OP_SEMICOLON, 0, 0, 0, 0},
    {0, ",", 0, OP_COMMA, 0, 0, 0, 0},
    {0, "return", 0, OP_RETURN, 1, 0, 0, 0},
    {0, "while", 0, OP_WHILE, 1, (Func) op_if, 0, 0},	/* `while' is like an `if' */

/* binary and unary operators - two character operators listed first */
    {0, ">=", 13, OP_BINARY, 0, (Func) op_ge, 0, 0},
    {0, "<=", 13, OP_BINARY, 0, (Func) op_le, 0, 0},
    {0, ">>", 13, OP_BINARY, 0, (Func) op_right_sh, 0, 0},
    {0, "<<", 13, OP_BINARY, 0, (Func) op_left_sh, 0, 0},
    {0, ">", 13, OP_BINARY, 0, (Func) op_gt, 0, 0},
    {0, "<", 13, OP_BINARY, 0, (Func) op_lt, 0, 0},
    {0, "!=", 12, OP_BINARY, 0, (Func) op_notequal, 0, 0},
    {0, "==", 12, OP_BINARY, 0, (Func) op_equal, 0, 0},
    {0, "=", 5, OP_BINARY, 0, (Func) op_assign, 0, 0},
    {0, "&&", 8, OP_BINARY, 0, (Func) op_and, 0, 0},
    {0, "||", 7, OP_BINARY, 0, (Func) op_or, 0, 0},
    {0, "!", 18, OP_UNARY, 0, (Func) op_lognot, 0, 0},
    {0, "-", 18, OP_UNARY, 0, (Func) op_neg, 0, 0},
    {0, "-", 15, OP_BINARY, 0, (Func) op_minus, 0, 0},
    {0, "+", 15, OP_BINARY, 0, (Func) op_plus, 0, 0},
    {0, "/", 16, OP_BINARY, 0, (Func) op_divide, 0, 0},
    {0, "%", 16, OP_BINARY, 0, (Func) op_mod, 0, 0},
    {0, "&", 19, OP_UNARY, 0, 0, 0, 0},
    {0, "&", 11, OP_BINARY, 0, (Func) op_logand, 0, 0},
    {0, "^", 10, OP_BINARY, 0, (Func) op_logxor, 0, 0},
    {0, "|", 9, OP_BINARY, 0, (Func) op_logor, 0, 0},

    {0, "strncmp", 0, OP_FUNCTION, 1, (Func) op_strncmp, 0, 3},

    {0, "strcmp", 0, OP_FUNCTION, 1, (Func) op_strcmp, 0, 2},
    {0, "strstr", 0, OP_FUNCTION, 1, (Func) op_strstr, 0, 2},
    {0, "strcat", 0, OP_FUNCTION, 1, (Func) op_strcat, 0, 2},

    {0, "strlen", 0, OP_FUNCTION, 1, (Func) op_strlen, 0, 1},
    {0, "depth", 0, OP_FUNCTION, 1, (Func) op_depth, 0, 1},
    {0, "exit", 0, OP_FUNCTION, 1, (Func) op_exit, 0, 1},
    {0, "system", 0, OP_FUNCTION, 1, (Func) op_system, 0, 1},
    {0, "popen", 0, OP_FUNCTION, 1, (Func) op_popen, 0, 1},

    {0, "fflush", 0, OP_FUNCTION, 1, (Func) op_fflush, 0, 0},
    {0, "printf", 0, OP_FUNCTION, 1, (Func) op_printf, 0, -1},	/* minus `one' mean `one' or more args */
    {0, "exec", 0, OP_FUNCTION, 1, (Func) op_exec, 0, -1},

    {0, "atoh", 0, OP_FUNCTION, 1, (Func) op_atoh, 0, 2},
    {0, "pow", 0, OP_FUNCTION, 1, (Func) op_powmod, 0, 3},
    {0, "format", 0, OP_FUNCTION, 1, (Func) op_format, 0, 2},

    {0, "incmod", 0, OP_FUNCTION, 1, (Func) op_inc_mod, 0, 2},
    {0, "addmod", 0, OP_FUNCTION, 1, (Func) op_add_mod, 0, 3},

    {0, "malloc", 0, OP_FUNCTION, 1, (Func) op_malloc, 0, 1},
    {0, "free", 0, OP_FUNCTION, 1, (Func) op_mfree, 0, 1},
    {0, "swap", 0, OP_FUNCTION, 1, (Func) op_swap, 0, 2},

    {0, "memxor", 0, OP_FUNCTION, 1, (Func) op_memxor, 0, 3},

    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0},
    {0, 0, 0, 0, 0, 0, 0}
};

static int n_operator = sizeof (operators) / sizeof (Operator);
static int last_operator = 0;

int parser_add_operator (Operator * o)
{
    int i;
    for (i = last_operator; i < n_operator; i++) {
	if (!operators[i].s) {
	    operators[i] = *o;
	    if (!operators[i].s)
		return 1;
	    if (!(*operators[i].s))
		return 1;
	    return 0;
	}
	last_operator = i;
    }
    return 1;
}

static int strecpy (char *c, char *s, int l)
{
    char *k = "0abtnvfr", *p;
    char *r = c;
    while (l-- > 0) {
	if (*s == '\\') {
	    s++;
	    l--;
	    if ((p = strchr (k, *s))) {
		*c++ = ("\0\007\b\t\n\v\f\r")[(unsigned long) p - (unsigned long) k];
	    } else {
		*c++ = *s;
	    }
	} else {
	    *c++ = *s;
	}
	s++;
    }
    *c = '\0';
    return (unsigned long) c - (unsigned long) r;
}

static int find_operator (char *p, char *s)
{
    int i;
    for (i = 0; i < n_operator; i++) {
	if (!operators[i].s)
	    break;
	if (memcmp (p, operators[i].s, operators[i].len))
	    continue;
	if (operators[i].whole_word) {
	    if ((unsigned long) p > (unsigned long) s)
		if (whole (*(p - 1)))
		    continue;
	    if (whole (*(p + operators[i].len)))
		continue;
	}
	return i;
    }
    return -1;
}

#define NEW_OP_VALUE(op_type,op_str,op_func,value_type,space)		\
	/* let this all free together */				\
	    c = malloc (sizeof (OpList) + sizeof (Operator) 		\
		    + sizeof (Value) + space);				\
	    if (temp)							\
		temp->next = (OpList *) c;				\
	    else							\
		t = (OpList *) c;					\
	    temp = (OpList *) c;					\
	    temp->next = 0;						\
	    temp->op = (Operator *) ((char *) c + sizeof (OpList));	\
	    temp->op->type = op_type;					\
	    temp->op->s = op_str;					\
	    temp->op->func = (Func) op_func;				\
	    temp->op->value = (Value *) ((char *) c + sizeof (OpList)	\
		+ sizeof (Operator));					\
	    temp->op->value->type = value_type;				\
	    temp->line = line;

struct {
    char *s;
    char *p;
    int type;
} declare[] = {

    {
	"char", "*****", VALUE_STRING | VALUE_P4
    },
    {
	"Huge", "*****", VALUE_HUGE | VALUE_P4
    },
    {
	"long", "****", VALUE_LONG | VALUE_P4
    },
    {
	"char", "****", VALUE_STRING | VALUE_P3
    },
    {
	"Huge", "****", VALUE_HUGE | VALUE_P3
    },
    {
	"long", "***", VALUE_LONG | VALUE_P3
    },
    {
	"char", "***", VALUE_STRING | VALUE_P2
    },
    {
	"Huge", "***", VALUE_HUGE | VALUE_P2
    },
    {
	"long", "**", VALUE_LONG | VALUE_P2
    },
    {
	"char", "**", VALUE_STRING | VALUE_P1
    },
    {
	"Huge", "**", VALUE_HUGE | VALUE_P1
    },
    {
	"long", "*", VALUE_LONG | VALUE_P1
    },
    {
	"char", "*", VALUE_STRING | VALUE_P0
    },
    {
	"Huge", "*", VALUE_HUGE | VALUE_P0
    },
    {
	"long", "", VALUE_LONG | VALUE_P0
    },
    {
	0, 0, 0
    }
};

int find_variable_declaration (char **r)
{
    char *p;
    int i;
    for (i = 0; declare[i].s; i++) {
	int l;
	p = *r;
	l = strlen (declare[i].s);
	if (strncmp (declare[i].s, p, l))
	    continue;
	if (whole (p[l]))
	    continue;
	p += l;
	while (strchr ("\t\n ", *p))
	    p++;
	l = strlen (declare[i].p);
	if (strncmp (declare[i].p, p, l))
	    continue;
	if (whole (p[l]) || strchr ("\t\n ", *p)) {
	    *r = p + l;
	    return declare[i].type;
	}
    }
    return -1;
}

static OpList *text_to_op_list (char *s, Value * variable)
{
    char *p;
    int found = 0;
    struct {
	char *name;
	int len;
	int type;
	long *p;
    } variable_names[256];
    int last_var = 0;
    OpList *t = 0;
    OpList *temp = 0;
    int line = 1;
    if (variable)
	variable[0].type = VALUE_END;
    if (!s)
	return 0;
    for (p = s; *p; p++) {
	int i;
/* skip whitespace */
	if (*p == ' ' || *p == '\t')
	    continue;
/* count lines */
	if (*p == '\n') {
	    line++;
	    continue;
	}
/* skip C++ comments */
	if (!memcmp (p, "//", 2)) {
	    while (*p++ != '\n')
		if (!*p)
		    break;
	    continue;
	}
/* skip C comments */
	if (!memcmp (p, "/*", 2)) {
	    p += 2;
	    while (memcmp (p, "*/", 2)) {
		if (!*p) {
		    preparser_error ("missing */", "at end of file", line);
		    STACK_FREE (t, free);
		    return 0;
		}
		if (*p == '\n')
		    line++;
		p++;
	    }
	    p++;
	    continue;
	}
	if (*p == '\"') {
	    char *q, *c;
	    unsigned long l;
	    p++;
	    q = p;
	    if (!t) {
		preparser_error ("out of place constant", p, line);
		return 0;
	    }
	    for (;; p++) {
		if (!*p) {
		    preparser_error ("missing \"", "at end of file", line);
		    STACK_FREE (t, free);
		    return 0;
		}
		if (*p == '\"')
		    break;
		if (!memcmp (p, "\\\"", 2))
		    p++;
	    }
	    l = (unsigned long) p - (unsigned long) q;
	    NEW_OP_VALUE (OP_VALUE, "__value__", op_value, VALUE_STRING, l + 1);
	    temp->op->value->v.s = c + sizeof (OpList) + sizeof (Operator) + sizeof (Value);
	    /* translate C escape sequences : */
	    temp->op->value->type |= strecpy (temp->op->value->v.s, q, l) & VALUE_LEN;
	    continue;
	}
	if (digit (*p)) {
	    char *q, *c;
	    long r;
	    if (!t) {
		preparser_error ("out of place constant", p, line);
		return 0;
	    }
	    q = p;
	    r = strtoul (p, &q, 0);
	    p = q - 1;
	    /* let this all free together */
	    NEW_OP_VALUE (OP_VALUE, "__value__", op_value, VALUE_LONG, 0);
	    temp->op->value->v.i = r;
	    continue;
	}
/* process tokens */
	i = find_operator (p, s);
	if (i >= 0) {
/* change unary minus to binary minus if necessary */
	    if (!strcmp (operators[i].s, "-")
		|| !strcmp (operators[i].s, "*")
		|| !strcmp (operators[i].s, "&"))
		if (temp)
		    if (temp->op->type == OP_VALUE || \
			temp->op->type == OP_VARIABLE || \
			temp->op->type == OP_EXPR_CLOSE || \
			temp->op->type == OP_ARRAY_CLOSE || \
			temp->op->type == OP_PREDEF || \
			temp->op->type == OP_CONSTANT)
			i++;
	    p += operators[i].len - 1;
	    if (!t) {
		t = temp = malloc (sizeof (OpList));
	    } else {
		temp->next = malloc (sizeof (OpList));
		temp = temp->next;
	    }
	    temp->next = 0;
	    temp->op = &operators[i];
	    temp->line = line;
	    continue;
	}
	i = find_variable_declaration (&p);
	if (i >= 0) {
	    char *q;
	    unsigned long l;
	    if (!variable) {
		preparser_error ("no heap for variables", p, line);
		STACK_FREE (t, free);
		return 0;
	    }
	    variable[last_var].v.i = 0;		/* initial value of zero */
	    variable[last_var].type = i;	/* initial type */
	    variable[last_var + 1].type = VALUE_END;	/* last variable in array */
	    while (strchr ("\t\n ", *p))
		p++;
	    q = p;
	    if (!whole (*p)) {
		preparser_error ("invalid declaration", p, line);
		STACK_FREE (t, free);
		return 0;
	    }
	    while (p) {
		if (!whole (*p))
		    break;
		p++;
	    }
	    l = p - q;
	    while (strchr ("\t\n ", *p))
		p++;
	    if (*p != ';') {
		preparser_error ("semi-colon expected", p, line);
		STACK_FREE (t, free);
		return 0;
	    }
	    /* create a new variable */
	    variable_names[last_var].name = q;
	    variable_names[last_var].len = l;
	    variable_names[last_var].p = &(variable[last_var].v.i);
	    variable_names[last_var].type = i;
	    last_var++;
	    continue;
	}
	for (i = 0; i < last_var; i++) {
	    char *c;
	    int l;
	    l = variable_names[i].len;
	    found = 0;
	    if (!strncmp (variable_names[i].name, p, l) && !whole (p[l])) {
		NEW_OP_VALUE (OP_VARIABLE, "__variable__", op_variable, variable_names[i].type, 0);
		temp->op->value->v.p = variable_names[i].p;
		found = 1;
		p += l - 1;
		break;
	    }
	}
	if (found)
	    continue;
	preparser_error ("unknown token", p, line);
	STACK_FREE (t, free);
	return 0;
    }
    return t;
}

static int expression (OpStack ** stack, OpList ** t);

static int tokens_to_stack (OpStack ** stack, OpList ** t)
{
    int done = 0;
    int error = 0;
    int type;
    for (; *t && !done && !error; (*t) = (*t)->next) {
	switch ((type = (*t)->op->type)) {
	case OP_UNARY:		/* this could be a '*' for an assignment to a dereferenced pointer */
	case OP_VARIABLE:{
		int line;
		line = (*t)->line;
		if (expression (stack, t))
		    error = 1;
		op_push (stack, &operators[OP_POP], line);
		if (!*t) {
		    parser_error ("semi-colon expected before end of file", 0);
		    error = 1;
		} else if ((*t)->op->type != OP_SEMICOLON) {
		    parser_error ("semi-colon expected at ", *t);
		    error = 1;
		}
		done = 1;
		break;
	    }
	case OP_USER_FUNCTION:
	case OP_FUNCTION:{
		int line;
		line = (*t)->line;
		if (expression (stack, t))
		    error = 1;
		op_push (stack, &operators[OP_POP], line);
		if (!*t) {
		    parser_error ("semi-colon expected before end of file", 0);
		    error = 1;
		} else if ((*t)->op->type != OP_SEMICOLON) {
		    parser_error ("semi-colon expected at ", *t);
		    error = 1;
		}
		done = 1;
		break;
	    }
	case OP_BLOCK_OPEN:{
		OpList *temp;
		temp = *t;
		(*t) = (*t)->next;
		if (!*t)
		    parser_error ("more expected", temp);
		while (!error && *t && (*t)->op->type != OP_BLOCK_CLOSE) {
		    if (tokens_to_stack (stack, t))
			error = 1;
		}
		if (!*t) {
		    parser_error ("} expected before end of file", 0);
		    error = 1;
		}
		done = 1;
		break;
	    }
	case OP_BLOCK_CLOSE:
	    parser_error ("stray", *t);
	    error = 1;
	    break;
	case OP_SEMICOLON:
	    done = 1;
	    break;
	case OP_RETURN:{
		OpList *temp;
		temp = *t;
		(*t) = (*t)->next;
		if (!*t) {
		    parser_error ("expression expected", temp);
		    return 1;
		}
		if (expression (stack, t))
		    error = 1;
		op_push (stack, temp->op, temp->line);
		if (!*t) {
		    parser_error ("semi-colon expected before end of file", 0);
		    error = 1;
		} else if ((*t)->op->type != OP_SEMICOLON) {
		    parser_error ("semi-colon expected at ", *t);
		    error = 1;
		}
		done = 1;
		break;
	    }
	case OP_WHILE:
	case OP_IF:{
/* Note: branches jump to the position AFTER where the jump points. This
   is because the stack counter gets incremented by one after the jump.
   Because the stack will be reversed before execution, we have to point
   to the position on the oposite side of where we want to jump to. */
		OpList *temp;
		OpStack *branch, *jump = 0;
		temp = *t;	/* save the if */
		(*t) = (*t)->next;
		jump = *stack;	/* loop position for OP_WHILE */
		if (!*t) {
		    parser_error ("expression expected", temp);
		    return 1;
		}
		if ((*t)->op->type == OP_EXPR_OPEN) {
		    (*t) = (*t)->next;
		    expression (stack, t);
		    if ((*t)->op->type != OP_EXPR_CLOSE)
			parser_error ("missing close bracket", temp);
		    else {
			(*t) = (*t)->next;
		    }
		} else {
		    error = 1;
		}
		op_push (stack, temp->op, temp->line);	/* push the if */
		branch = *stack;
		if (tokens_to_stack (stack, t))
		    error = 1;
		if (*t && (*t)->op->type == OP_ELSE && type == OP_IF) {
		    op_push (stack, &operators[OP_GOTO], temp->line);
		    jump = *stack;
		    branch->branch = *stack;
		    (*t) = (*t)->next;
		    if (tokens_to_stack (stack, t))
			error = 1;
		    jump->branch = *stack;
		} else if (type == OP_WHILE) {
		    op_push (stack, &operators[OP_GOTO], temp->line);
		    branch->branch = *stack;
		    (*stack)->branch = jump;
		} else {
		    branch->branch = *stack;
		}
		return error;
		break;
	    }
	default:
	    parser_error ("in the middle of nowhere", *t);
	    error = 1;
	    break;
	}
	if (!*t) {
	    parser_error ("stuff missing from end of file", 0);
	    return 1;
	}
    }
    return error;
}

static int expression (OpStack ** stack, OpList ** t)
{
    int done = 0;
    int error = 0;
    int type;
    OpStack *temp_stack = 0;
    int last_type = 0;
    for (; *t && !done && !error; (*t) = (*t)->next) {
	switch ((type = (*t)->op->type)) {
	case OP_ARRAY_CLOSE:
	case OP_EXPR_CLOSE:
	case OP_SEMICOLON:
	case OP_COMMA:{
		Operator *op;
		while ((op = op_pop (&temp_stack)))
		    op_push (stack, op, (*t)->line);
		op_free (op);
		return 0;
	    }
	case OP_ARRAY_OPEN:
	    if (last_type && last_type != OP_EXPR_CLOSE
		&& last_type != OP_ARRAY_CLOSE
		&& last_type != OP_VARIABLE
		&& last_type != OP_VALUE
		&& last_type != OP_CONSTANT
		&& last_type != OP_PREDEF) {
		parser_error ("missing operator", *t);
		error = 1;
	    }
	    last_type = 0;
	    op_push (&temp_stack, (*t)->op, (*t)->line);
	    /* now continue as though we have a ( */
	case OP_EXPR_OPEN:{
		OpList *temp;
		temp = *t;
		if (last_type && last_type != OP_BINARY && last_type != OP_UNARY) {
		    parser_error ("missing operator", *t);
		    error = 1;
		    break;
		}
		(*t) = (*t)->next;
		if (!*t) {
		    parser_error ("stuff missing from end of file", temp);
		    return 1;
		}
		expression (stack, t);
		if ((*t)->op->type != (type + 1)) {	/* OP_EXPR_OPEN becomes OP_EXPR_CLOSE */
		    /* OP_ARRAY_OPEN becomes OP_ARRAY_CLOSE */
		    parser_error ("missing close bracket", temp);
		    error = 1;
		}
		goto pop_binary_operators;
	    }
	case OP_BINARY:
	    if (last_type && last_type != OP_EXPR_CLOSE
		&& last_type != OP_ARRAY_CLOSE
		&& last_type != OP_VALUE
		&& last_type != OP_VARIABLE
		&& last_type != OP_CONSTANT
		&& last_type != OP_PREDEF) {
		parser_error ("missing operator", *t);
		error = 1;
	    }
	case OP_UNARY:
	    op_push (&temp_stack, (*t)->op, (*t)->line);
	    break;
	case OP_USER_FUNCTION:
	case OP_FUNCTION:
	    if (last_type && last_type != OP_BINARY && last_type != OP_UNARY) {
		parser_error ("missing operator", *t);
		error = 1;
	    } else {
		int i = 0;
		OpList *temp;
		Operator *op;
		int line, nargs;
		line = (*t)->line;
		nargs = (*t)->op->nargs;
		temp = *t;
		op = (*t)->op;	/* save the function for pushing */
		if (nargs < 0)	/* var args function: must terminate args with a noop */
		    op_push (stack, &operators[OP_ENDVARARGS], line);
		(*t) = (*t)->next;
		if (!*t) {
		    parser_error ("missing function open bracket", temp);
		    error = 1;
		    break;
		}
		if ((*t)->op->type != OP_EXPR_OPEN) {
		    parser_error ("missing function open bracket", temp);
		    error = 1;
		    break;
		}
		temp = *t;
		(*t) = (*t)->next;
		if (!*t) {
		    parser_error ("more expected", temp);
		    error = 1;
		    break;
		}
		while (!done && (*t)->op->type != OP_EXPR_CLOSE) {
		    if (expression (stack, t)) {
			error = 1;
			done = 1;
		    }
		    if (!*t) {
			parser_error ("missing )", temp);
			error = 1;
			break;
		    } else if ((*t)->op->type == OP_COMMA) {
			(*t) = (*t)->next;
		    } else if ((*t)->op->type == OP_EXPR_CLOSE) {
			/* all ok */
		    } else {
			parser_error ("missing )", temp);
			error = 1;
			break;
		    }
		    i++;
		}
		op_push (stack, op, line);	/* push the function itself */
		if ((nargs != i && nargs >= 0) || (nargs < -i && nargs < 0)) {
		    parser_error ("incorrect number of arguments to function", temp);
		    error = 1;
		}
		goto pop_binary_operators;
	    }
	case OP_PREDEF:
	case OP_CONSTANT:
	case OP_VALUE:
	    if (last_type && last_type != OP_BINARY && last_type != OP_UNARY) {
		parser_error ("missing operator", *t);
		error = 1;
	    }
	case OP_VARIABLE:{
		Operator *op;
		if (temp_stack && type == OP_VARIABLE && !strcmp (temp_stack->op->s, "&")) {
		    op_push (stack, (*t)->op, (*t)->line);
		    (*stack)->op->type = OP_VALUE;
		    (*stack)->op->func = (Func) op_value;	/* make it a value */
		    (*stack)->op->value->type += VALUE_P0;
		    op = op_pop (&temp_stack);	/* dump the & */
		    op_free (op);
		} else if (type == OP_VARIABLE && !strcmp ((*t)->next->op->s, "=")) {
		    if (temp_stack && !strcmp (temp_stack->op->s, "*")) {
			op_push (stack, (*t)->op, (*t)->line);
		    } else {
			if (last_type) {
			    parser_error ("bad left operand to = ", *t);
			    error = 1;
			}
			op_push (stack, (*t)->op, (*t)->line);
			(*stack)->op->type = OP_VALUE;
			(*stack)->op->func = (Func) op_value;
			(*stack)->op->value->type += VALUE_P0;
			op_push (&temp_stack, &operators[OP_POINTER], (*t)->line);
		    }
		} else {
		    op_push (stack, (*t)->op, (*t)->line);
		}
/* (*temp_stack) is the stack top */
	      pop_binary_operators:
		while (temp_stack && (*t)->next->op->priority <= temp_stack->op->priority) {
		    if (!strcmp ((*t)->next->op->s, "=")) {
/* assignments to pointer dereferences are a special case 'cos we want
   the dereference to end up after the assignment */
			if (*temp_stack->op->s == '[' || *temp_stack->op->s == '*')
			    break;
/* = has right ot left precedince : */
			if ((*t)->next->op->priority == temp_stack->op->priority)
			    break;
		    }
		    op_push (stack, op = op_pop (&temp_stack), (*t)->line);
		    op_free (op);
		}
		break;
	    }
	default:
	    parser_error ("in the middle of nowhere", *t);
	    error = 1;
	    break;
	}
	if (*t)
	    last_type = (*t)->op->type;
	else {
	    break;
	}
    }
    return error;
}

int parser_evaluate (void *s, void *user_data)
{
    OpStack *stack = (OpStack *) s;
    ValueStack *v = 0;
    Value value;
    int result = 0;
    while (stack) {
	int r;
	int type;
	type = stack->op->type;
	if (type == OP_PREDEF || type == OP_USER_FUNCTION) {
	    r = (stack->op->func) (user_data, &v);
	} else {
	    r = (stack->op->func) (&stack, &v);
	}
	if (r)
	    goto cleanup;
	stack = stack->next;
	if (!stack)
	    goto cleanup;
	if (stack->op->type == OP_RETURN) {
	    if (v)
		result = v->value.v.i;
	    goto cleanup;
	}
    }
  cleanup:
    while (v) {
	value = value_pop (&v);
	value_free (value);
    }
    return result;
}

void dump_oplist (OpList * t)
{
    printf ("oplist----------------->\n");
    while (t) {
	if (t->op->type == OP_VALUE) {
	    if (t->op->value->type & VALUE_LONG) {
		printf ("%d:%s:%ld\n", t->line, t->op->s, t->op->value->v.i);
	    } else if (t->op->value->type & VALUE_STRING) {
		printf ("%d:%s:%s\n", t->line, t->op->s, t->op->value->v.s);
	    }
	} else if (t->op->type == OP_VARIABLE) {
	    printf ("%d:%s:*(%ld)=%ld\n", t->line, t->op->s, (unsigned long) t->op->value->v.p, *t->op->value->v.p);
	} else {
	    printf ("%d:%s\n", t->line, t->op->s);
	}
	t = t->next;
    }
}

void dump_valuestack (ValueStack * t)
{
    printf ("valuelist----------------->\n");
    while (t) {
	if (t->value.type & VALUE_LONG) {
	    printf ("long:%ld\n", t->value.v.i);
	} else if (t->value.type & VALUE_STRING) {
	    printf ("string:%s\n", t->value.v.s);
	} else if (t->value.type & VALUE_ENDVARARGS) {
	    printf ("endargs\n");
	}
	t = t->next;
    }
}

void dump_stack (OpStack * t)
{
    printf ("opstack----------------->\n");
    while (t) {
	if (t->op->type == OP_VALUE) {
	    if (t->op->value->type & VALUE_LONG) {
		printf ("%d:(0x%lx):%s:%ld\n", t->line, (unsigned long) t, t->op->s, t->op->value->v.i);
	    } else if (t->op->value->type & VALUE_STRING) {
		printf ("%d:(0x%lx):%s:%s\n", t->line, (unsigned long) t, t->op->s, t->op->value->v.s);
	    }
	} else if (t->op->type == OP_VARIABLE) {
	    printf ("%d:%s:*(%ld)=%ld\n", t->line, t->op->s, (unsigned long) t->op->value->v.p, *t->op->value->v.p);
	} else {
	    printf ("%d:(0x%lx):%s\n", t->line, (unsigned long) t, t->op->s);
	}
	if (t->branch)
	    printf ("branch---> (0x%lx)\n", (unsigned long) t->branch);
	t = t->next;
    }
}

OpStack *reverse_stack (OpStack * stack)
{
    OpStack *prev;
    OpStack *start = stack;
    if (!stack)
	return 0;
    stack->prev = 0;
    while (stack) {
	prev = stack;
	stack = stack->next;
	if (stack)
	    stack->prev = prev;
    }
    stack = start;
    for (;;) {
	prev = stack->prev;
	stack->prev = stack->next;
	stack->next = prev;
	if (!stack->prev)
	    break;
	stack = stack->prev;
    }
    return stack;
}

static void *all_alloced[256];
static int num_alloced = 0;

void *parser_compile (char *text, Value * heap)
{
    int i;
    OpStack *stack = 0;
    OpList *t, *temp;
    temp = t = text_to_op_list (text, heap);
    if (!t)
	return 0;
    while (t) {
	if (tokens_to_stack (&stack, &t)) {
	    STACK_FREE (stack, opstack_free);
	    break;
	}
    }
    STACK_FREE (temp, free);
    stack = reverse_stack (stack);
    if (stack) {
	for (i = 0; i < num_alloced; i++)
	    if (!all_alloced[i])
		return (all_alloced[i] = (void *) stack);
	return (all_alloced[num_alloced++] = (void *) stack);
    }
    return 0;
}

void parser_free (void *s, Value * heap)
{
    int i;
    OpStack *stack = (OpStack *) s;
    for (i = 0; i < num_alloced; i++)
	if (all_alloced[i] == s) {
	    all_alloced[i] = 0;
	    break;
	}
    STACK_FREE (stack, opstack_free);
    if (heap)
	for (i = 0; heap[i].type != VALUE_END; i++)
	    value_free (heap[i]);
}

void parser_init (void)
{
    int i;
    for (i = 0; i < n_operator; i++) {
	if (!operators[i].s)
	    break;
	operators[i].len = strlen (operators[i].s);
	if (operators[i].type == OP_CONSTANT && !operators[i].value) {
	    operators[i].value = malloc (sizeof (Value));
	    operators[i].value->type = VALUE_LONG;
	    operators[i].value->v.i = (long) operators[i].func;
	    operators[i].func = op_value;
	}
    }
}

void parser_shut (void)
{
    int i;
    for (i = 0; i < num_alloced; i++)
	if (all_alloced[i])
	    parser_free (all_alloced[i], 0);
    for (i = 0; i < n_operator; i++) {
	if (!operators[i].s)
	    break;
	if (operators[i].value) {
	    long k;
	    k = operators[i].value->v.i;
	    free (operators[i].value);
	    operators[i].value = 0;
	    operators[i].func = (Func) k;
	}
    }
}