/*
 * (c) Thomas Pornin 1999 - 2002
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions
 * are met:
 * 1. Redistributions of source code must retain the above copyright
 *    notice, this list of conditions and the following disclaimer.
 * 2. Redistributions in binary form must reproduce the above copyright
 *    notice, this list of conditions and the following disclaimer in the
 *    documentation and/or other materials provided with the distribution.
 * 4. The name of the authors may not be used to endorse or promote
 *    products derived from this software without specific prior written
 *    permission.
 *
 * THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
 * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
 * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
 * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE
 * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
 * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT
 * OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
 * BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
 * OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
 * EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 *
 */

#include "tune.h"
#include <stdio.h>
#include <string.h>
#include <setjmp.h>
#include <limits.h>
#include "ucppi.h"
#include "mem.h"

JMP_BUF eval_exception;
long eval_line;
static int emit_eval_warnings;

/*
 * If you want to hardcode a conversion table, define a static array
 * of 256 int, and make transient_characters point to it.
 */
int *transient_characters = 0;

#define OCTAL(x)       ((x) >= '0' && (x) <= '7')
#define DECIM(x)       ((x) >= '0' && (x) <= '9')
#define HEXAD(x)       (DECIM(x) \
                       || (x) == 'a' || (x) == 'b' || (x) == 'c' \
                       || (x) == 'd' || (x) == 'e' || (x) == 'f' \
                       || (x) == 'A' || (x) == 'B' || (x) == 'C' \
                       || (x) == 'D' || (x) == 'E' || (x) == 'F')
#define OVAL(x)	       ((int)((x) - '0'))
#define DVAL(x)	       ((int)((x) - '0'))
#define HVAL(x)	       (DECIM(x) ? DVAL(x) \
                       : (x) == 'a' || (x) == 'A' ? 10 \
                       : (x) == 'b' || (x) == 'B' ? 11 \
                       : (x) == 'c' || (x) == 'C' ? 12 \
                       : (x) == 'd' || (x) == 'D' ? 13 \
                       : (x) == 'e' || (x) == 'E' ? 14 : 15)

#define ARITH_TYPENAME             big
#define ARITH_FUNCTION_HEADER      static inline

#define ARITH_ERROR(type)          z_error(type)
static void z_error(int type);

#ifdef ARITHMETIC_CHECKS
#define ARITH_WARNING(type)        z_warn(type)
static void z_warn(int type);
#endif

#include "arith.c"

static void z_error(int type)
{
	switch (type) {
	case ARITH_EXCEP_SLASH_D:
		error(eval_line, "division by 0");
		break;
	case ARITH_EXCEP_SLASH_O:
		error(eval_line, "overflow on division");
		break;
	case ARITH_EXCEP_PCT_D:
		error(eval_line, "division by 0 on modulus operator");
		break;
	case ARITH_EXCEP_CONST_O:
		error(eval_line, "constant too large for destination type");
		break;
#ifdef AUDIT
	default:
		ouch("erroneous integer error: %d", type);
#endif
	}
	throw(eval_exception);
}

#ifdef ARITHMETIC_CHECKS
static void z_warn(int type)
{
	switch (type) {
	case ARITH_EXCEP_CONV_O:
		warning(eval_line, "overflow on integer conversion");
		break;
	case ARITH_EXCEP_NEG_O:
		warning(eval_line, "overflow on unary minus");
		break;
	case ARITH_EXCEP_NOT_T:
		warning(eval_line,
			"bitwise inversion yields trap representation");
		break;
	case ARITH_EXCEP_PLUS_O:
		warning(eval_line, "overflow on addition");
		break;
	case ARITH_EXCEP_PLUS_U:
		warning(eval_line, "underflow on addition");
		break;
	case ARITH_EXCEP_MINUS_O:
		warning(eval_line, "overflow on subtraction");
		break;
	case ARITH_EXCEP_MINUS_U:
		warning(eval_line, "underflow on subtraction");
		break;
	case ARITH_EXCEP_AND_T:
		warning(eval_line,
			"bitwise AND yields trap representation");
		break;
	case ARITH_EXCEP_XOR_T:
		warning(eval_line,
			"bitwise XOR yields trap representation");
		break;
	case ARITH_EXCEP_OR_T:
		warning(eval_line,
			"bitwise OR yields trap representation");
		break;
	case ARITH_EXCEP_LSH_W:
		warning(eval_line, "left shift count greater than "
			"or equal to type width");
		break;
	case ARITH_EXCEP_LSH_C:
		warning(eval_line, "left shift count negative");
		break;
	case ARITH_EXCEP_LSH_O:
		warning(eval_line, "overflow on left shift");
		break;
	case ARITH_EXCEP_RSH_W:
		warning(eval_line, "right shift count greater than "
			"or equal to type width");
		break;
	case ARITH_EXCEP_RSH_C:
		warning(eval_line, "right shift count negative");
		break;
	case ARITH_EXCEP_RSH_N:
		warning(eval_line, "right shift of negative value");
		break;
	case ARITH_EXCEP_STAR_O:
		warning(eval_line, "overflow on multiplication");
		break;
	case ARITH_EXCEP_STAR_U:
		warning(eval_line, "underflow on multiplication");
		break;
#ifdef AUDIT
	default:
		ouch("erroneous integer warning: %d", type);
#endif
	}
}
#endif

typedef struct {
	int sign;
	union {
		u_big uv;
		s_big sv;
	} u;
} ppval;

static int boolval(ppval x)
{
	return x.sign ? big_s_lval(x.u.sv) : big_u_lval(x.u.uv);
}

#if !defined(WCHAR_SIGNEDNESS)
#  if CHAR_MIN == 0
#    define WCHAR_SIGNEDNESS	0
#  else
#    define WCHAR_SIGNEDNESS	1
#  endif
#endif

/*
 * Check the suffix, return 1 if it is signed, 0 otherwise. 1 is
 * returned for a void suffix. Legal suffixes are:
 * unsigned: u U ul uL Ul UL lu Lu lU LU ull uLL Ull ULL llu LLu llU LLU
 * signed: l L ll LL
 */
static int pp_suffix(char *d, char *refc)
{
	if (!*d) return 1;
	if (*d == 'u' || *d == 'U') {
		if (!*(++ d)) return 0;
		if (*d == 'l' || *d == 'L') {
			char *e = d + 1;

			if (*e && *e != *d) goto suffix_error;
			if (!*e || !*(e + 1)) return 0;
			goto suffix_error;
		}
		goto suffix_error;
	}
	if (*d == 'l' || *d == 'L') {
		if (!*(++ d)) return 1;
		if (*d == *(d - 1)) {
			d ++;
			if (!*d) return 1;
		}
		if (*d == 'u' || *d == 'U') {
			d ++;
			if (!*d) return 0;
		}
		goto suffix_error;
	}
suffix_error:
	error(eval_line, "invalid integer constant '%s'", refc);
	throw(eval_exception);
	return 666;
}

static unsigned long pp_char(char *c, char *refc)
{
	unsigned long r = 0;

	c ++;
	if (*c == '\\') {
		int i;

		c ++;
		switch (*c) {
		case 'n': r = '\n'; c ++; break;
		case 't': r = '\t'; c ++; break;
		case 'v': r = '\v'; c ++; break;
		case 'b': r = '\b'; c ++; break;
		case 'r': r = '\r'; c ++; break;
		case 'f': r = '\f'; c ++; break;
		case 'a': r = '\a'; c ++; break;
		case '\\': r = '\\'; c ++; break;
		case '\?': r = '\?'; c ++; break;
		case '\'': r = '\''; c ++; break;
		case '\"': r = '\"'; c ++; break;
		case 'u':
			for (i = 0, c ++; i < 4 && HEXAD(*c); i ++, c ++) {
				r = (r * 16) + HVAL(*c);
			}
			if (i != 4) {
				error(eval_line, "malformed UCN in %s", refc);
				throw(eval_exception);
			}
			break;
		case 'U':
			for (i = 0, c ++; i < 8 && HEXAD(*c); i ++, c ++) {
				r = (r * 16) + HVAL(*c);
			}
			if (i != 8) {
				error(eval_line, "malformed UCN in %s", refc);
				throw(eval_exception);
			}
			break;
		case 'x':
			for (c ++; HEXAD(*c); c ++) r = (r * 16) + HVAL(*c);
			break;
		default:
			if (OCTAL(*c)) {
				r = OVAL(*(c ++));
				if (OCTAL(*c)) r = (r * 8) + OVAL(*(c ++));
				if (OCTAL(*c)) r = (r * 8) + OVAL(*(c ++));
			} else {
				error(eval_line, "invalid escape sequence "
					"'\\%c'", *c);
				throw(eval_exception);
			}
		}
	} else if (*c == '\'') {
		error(eval_line, "empty character constant");
		throw(eval_exception);
	} else {
		r = *((unsigned char *)(c ++));
	}

	if (transient_characters && r < 256) {
		r = transient_characters[(size_t)r];
	}

	if (*c != '\'' && emit_eval_warnings) {
		warning(eval_line, "multicharacter constant");
	}
	return r;
}

static ppval pp_strtoconst(char *refc)
{
	ppval q;
	char *c = refc, *d;
	u_big ru;
	s_big rs;
	int sp, dec;

	if (*c == '\'' || *c == 'L') {
		q.sign = (*c == 'L') ? WCHAR_SIGNEDNESS : 1;
		if (*c == 'L' && *(++ c) != '\'') {
			error(eval_line,
				"invalid wide character constant: %s", refc);
			throw(eval_exception);
		}
		if (q.sign) {
			q.u.sv = big_s_fromlong(pp_char(c, refc));
		} else {
			q.u.uv = big_u_fromulong(pp_char(c, refc));
		}
		return q;
	}
	if (*c == '0') {
		/* octal or hexadecimal */
		dec = 0;
		c ++;
		if (*c == 'x' || *c == 'X') {
			c ++;
			d = big_u_hexconst(c, &ru, &rs, &sp);
		} else {
			d = big_u_octconst(c, &ru, &rs, &sp);
		}
	} else {
		dec = 1;
		d = big_u_decconst(c, &ru, &rs, &sp);
	}
	q.sign = pp_suffix(d, refc);
	if (q.sign) {
		if (!sp) {
			if (dec) {
				error(eval_line, "constant too large "
					"for destination type");
				throw(eval_exception);
			} else {
				warning(eval_line, "constant is so large "
					"that it is unsigned");
			}
			q.u.uv = ru;
			q.sign = 0;
		} else {
			q.u.sv = rs;
		}
	} else {
		q.u.uv = ru;
	}
	return q;
}

/*
 * Used by #line directives -- anything beyond what can be put in an
 * unsigned long, is considered absurd.
 */
unsigned long strtoconst(char *c)
{
	ppval q = pp_strtoconst(c);

	if (q.sign) q.u.uv = big_s_to_u(q.u.sv);
	return big_u_toulong(q.u.uv);
}

#define OP_UN(x)	((x) == LNOT || (x) == NOT || (x) == UPLUS \
			|| (x) == UMINUS)

static ppval eval_opun(int op, ppval v)
{
	if (op == LNOT) {
		v.sign = 1;
		v.u.sv = big_s_fromint(big_s_lnot(v.u.sv));
		return v;
	}
	if (v.sign) {
		switch (op) {
		case NOT: v.u.sv = big_s_not(v.u.sv); break;
		case UPLUS: break;
		case UMINUS: v.u.sv = big_s_neg(v.u.sv); break;
		}
	} else {
		switch (op) {
		case NOT: v.u.uv = big_u_not(v.u.uv); break;
		case UPLUS: break;
		case UMINUS: v.u.uv = big_u_neg(v.u.uv); break;
		}
	}
	return v;
}

#define OP_BIN(x)      ((x) == STAR || (x) == SLASH || (x) == PCT \
                       || (x) == PLUS || (x) == MINUS || (x) == LSH \
                       || (x) == RSH || (x) == LT || (x) == LEQ \
                       || (x) == GT || (x) == GEQ || (x) == SAME \
                       || (x) == NEQ || (x) == AND || (x) == CIRC \
                       || (x) == OR || (x) == LAND || (x) == LOR \
                       || (x) == COMMA)

static ppval eval_opbin(int op, ppval v1, ppval v2)
{
	ppval r;
	int iv2 = 0;

	switch (op) {
	case STAR:	case SLASH:	case PCT:
	case PLUS:	case MINUS:	case AND:
	case CIRC:	case OR:
		/* promote operands, adjust signedness of result */
		if (!v1.sign || !v2.sign) {
			if (v1.sign) {
				v1.u.uv = big_s_to_u(v1.u.sv);
				v1.sign = 0;
			} else if (v2.sign) {
				v2.u.uv = big_s_to_u(v2.u.sv);
				v2.sign = 0;
			}
			r.sign = 0;
		} else {
			r.sign = 1;
		}
		break;
	case LT:	case LEQ:	case GT:
	case GEQ:	case SAME:	case NEQ:
		/* promote operands */
		if (!v1.sign || !v2.sign) {
			if (v1.sign) {
				v1.u.uv = big_s_to_u(v1.u.sv);
				v1.sign = 0;
			} else if (v2.sign) {
				v2.u.uv = big_s_to_u(v2.u.sv);
				v2.sign = 0;
			}
		}
		/* fall through */
	case LAND:
	case LOR:
		/* result is signed anyway */
		r.sign = 1;
		break;
	case LSH:
	case RSH:
		/* result is as signed as left operand; convert right
		   operand to int */
		r.sign = v1.sign;
		if (v2.sign) {
			iv2 = big_s_toint(v2.u.sv);
		} else {
			iv2 = big_u_toint(v2.u.uv);
		}
		break;
	case COMMA:
		if (emit_eval_warnings) {
			warning(eval_line, "ISO C forbids evaluated comma "
				"operators in #if expressions");
		}
		r.sign = v2.sign;
		break;
#ifdef AUDIT
	default: ouch("a good operator is a dead operator");
#endif
	}

#define SBINOP(x)	if (r.sign) r.u.sv = big_s_ ## x (v1.u.sv, v2.u.sv); \
			else r.u.uv = big_u_ ## x (v1.u.uv, v2.u.uv);

#define NSSBINOP(x)	if (v1.sign) r.u.sv = big_s_fromint(big_s_ ## x \
			(v1.u.sv, v2.u.sv)); else r.u.sv = big_s_fromint( \
			big_u_ ## x (v1.u.uv, v2.u.uv));

#define LBINOP(x)	if (v1.sign) r.u.sv = big_s_fromint( \
			big_s_lval(v1.u.sv) x big_s_lval(v2.u.sv)); \
			else r.u.sv = big_s_fromint( \
			big_u_lval(v1.u.uv) x big_u_lval(v2.u.uv));

#define ABINOP(x)	if (r.sign) r.u.sv = big_s_ ## x (v1.u.sv, iv2); \
			else r.u.uv = big_u_ ## x (v1.u.uv, iv2);

	switch (op) {
	case STAR: SBINOP(star); break;
	case SLASH: SBINOP(slash); break;
	case PCT: SBINOP(pct); break;
	case PLUS: SBINOP(plus); break;
	case MINUS: SBINOP(minus); break;
	case LSH: ABINOP(lsh); break;
	case RSH: ABINOP(rsh); break;
	case LT: NSSBINOP(lt); break;
	case LEQ: NSSBINOP(leq); break;
	case GT: NSSBINOP(gt); break;
	case GEQ: NSSBINOP(geq); break;
	case SAME: NSSBINOP(same); break;
	case NEQ: NSSBINOP(neq); break;
	case AND: SBINOP(and); break;
	case CIRC: SBINOP(xor); break;
	case OR: SBINOP(or); break;
	case LAND: LBINOP(&&); break;
	case LOR: LBINOP(||); break;
	case COMMA: r = v2; break;
	}
	return r;
}

#define ttOP(x)		(OP_UN(x) || OP_BIN(x) || (x) == QUEST || (x) == COLON)

static int op_prec(int op)
{
	switch (op) {
	case LNOT:
	case NOT:
	case UPLUS:
	case UMINUS:
		return 13;
	case STAR:
	case SLASH:
	case PCT:
		return 12;
	case PLUS:
	case MINUS:
		return 11;
	case LSH:
	case RSH:
		return 10;
	case LT:
	case LEQ:
	case GT:
	case GEQ:
		return 9;
	case SAME:
	case NEQ:
		return 8;
	case AND:
		return 7;
	case CIRC:
		return 6;
	case OR:
		return 5;
	case LAND:
		return 4;
	case LOR:
		return 3;
	case QUEST:
		return 2;
	case COMMA:
		return 1;
	}
#ifdef AUDIT
	ouch("an unknown species should have a higher precedence");
#endif
	return 666;
}

/*
 * Perform the hard work of evaluation.
 *
 * This function works because:
 * -- all unary operators are right to left associative, and with
 *    identical precedence
 * -- all binary operators are left to right associative
 * -- there is only one non-unary and non-binary operator: the quest-colon
 *
 * If do_eval is 0, the evaluation of operators is not done. This is
 * for sequence point operators (&&, || and ?:).
 */
static ppval eval_shrd(struct token_fifo *tf, int minprec, int do_eval)
{
	ppval top;
	struct token *ct;

	top.sign = 1;
	if (tf->art == tf->nt) goto trunc_err;
	ct = tf->t + (tf->art ++);
	if (ct->type == LPAR) {
		top = eval_shrd(tf, 0, do_eval);
		if (tf->art == tf->nt) goto trunc_err;
		ct = tf->t + (tf->art ++);
		if (ct->type != RPAR) {
			error(eval_line, "a right parenthesis was expected");
			throw(eval_exception);
		}
	} else if (ct->type == NUMBER || ct->type == CHAR) {
		top = pp_strtoconst(ct->name);
	} else if (OP_UN(ct->type)) {
		top = eval_opun(ct->type, eval_shrd(tf,
			op_prec(ct->type), do_eval));
		goto eval_loop;
	} else if (ttOP(ct->type)) goto rogue_op_err;
	else {
		goto invalid_token_err;
	}

eval_loop:
	if (tf->art == tf->nt) {
		return top;
	}
	ct = tf->t + (tf->art ++);
	if (OP_BIN(ct->type)) {
		int bp = op_prec(ct->type);

		if (bp > minprec) {
			ppval tr;

			if ((ct->type == LOR && boolval(top))
				|| (ct->type == LAND && !boolval(top))) {
				tr = eval_shrd(tf, bp, 0);
				if (do_eval) {
					top.sign = 1;
					if (ct->type == LOR)
						top.u.sv = big_s_fromint(1);
					if (ct->type == LAND)
						top.u.sv = big_s_fromint(0);
				}
			} else {
				tr = eval_shrd(tf, bp, do_eval);
				if (do_eval)
					top = eval_opbin(ct->type, top, tr);
			}
			goto eval_loop;
		}
	} else if (ct->type == QUEST) {
		int bp = op_prec(QUEST);
		ppval r1, r2;

		if (bp >= minprec) {
			int qv = boolval(top);

			r1 = eval_shrd(tf, bp, qv ? do_eval : 0);
			if (tf->art == tf->nt) goto trunc_err;
			ct = tf->t + (tf->art ++);
			if (ct->type != COLON) {
				error(eval_line, "a colon was expected");
				throw(eval_exception);
			}
			r2 = eval_shrd(tf, bp, qv ? 0 : do_eval);
			if (do_eval) {
				if (qv) top = r1; else top = r2;
			}
			goto eval_loop;
		}
	}
	tf->art --;
	return top;

trunc_err:
	error(eval_line, "truncated constant integral expression");
	throw(eval_exception);
rogue_op_err:
	error(eval_line, "rogue operator '%s' in constant integral "
		"expression", operators_name[ct->type]);
	throw(eval_exception);
invalid_token_err:
	error(eval_line, "invalid token in constant integral expression");
	throw(eval_exception);
}

#define UNARY(x)	((x) != NUMBER && (x) != NAME && (x) != CHAR \
			&& (x) != RPAR)

/*
 * Evaluate the integer expression contained in the given token_fifo.
 * Evaluation is made by precedence of operators, as described in the
 * Dragon Book. The unary + and - are distinguished from their binary
 * counterparts using the Fortran way: a + or a - is considered unary
 * if it does not follow a constant, an identifier or a right parenthesis.
 */
unsigned long eval_expr(struct token_fifo *tf, int *ret, int ew)
{
	size_t sart;
	ppval r;

	emit_eval_warnings = ew;
	if (catch(eval_exception)) goto eval_err;
	/* first, distinguish unary + and - from binary + and - */
	for (sart = tf->art; tf->art < tf->nt; tf->art ++) {
		if (tf->t[tf->art].type == PLUS) {
			if (sart == tf->art || UNARY(tf->t[tf->art - 1].type))
				tf->t[tf->art].type = UPLUS;
		} else if (tf->t[tf->art].type == MINUS) {
			if (sart == tf->art || UNARY(tf->t[tf->art - 1].type))
				tf->t[tf->art].type = UMINUS;
		}
	}
	tf->art = sart;
	r = eval_shrd(tf, 0, 1);
	if (tf->art < tf->nt) {
		error(eval_line, "trailing garbage in constant integral "
			"expression");
		goto eval_err;
	}
	*ret = 0;
	return boolval(r);
eval_err:
	*ret = 1;
	return 0;
}