/*
 *	expr.c
 */

#include "os.h"
#include "symbtbl.h"
#include "mc.h"
#include "mctypes.h"

#ifdef MSDOS
# include "y_tab.h"
# include "lex_yy.h"
#endif
#ifndef MSDOS
# include "y.tab.h"
# include "lex.yy.h"
#endif

#include "expr.h"

#define YYERROR	{retval.s.art.stbltyp = NULL; return (retval);}

YYSTYPE
eval_constexpr(lv1, lv2, lv3)
	YYSTYPE	lv1, lv2, lv3;
{
	TypeArt	ta1, ta3;
	YYSTYPE	retval;
	long	l;
	double	d;

	ta1 = lookforgentypeart (lv1.s.art.stbltyp);
	ta3 = lookforgentypeart (lv3.s.art.stbltyp);

	retval = lv1;
	retval.s.flag.is_const = 1;
	retval.s.flag.is_lvalue = 0;

	switch (lv2.s.art.oa) {
	case op_and:
	case op_or:
	case op_xor:
					/* Boolean, Int-Typen */
		if ((! (ta1.is_boolean || ta1.is_byte))
		    || (! (ta3.is_boolean || ta3.is_byte))) {
		    	break;
		}

		/* ab hier beide Boolean oder Int-Typ */
		
		if (ta1.is_boolean && ta3.is_byte) {
			break;
		}
		if (ta3.is_boolean && ta1.is_byte) {
			break;
		}

		/* ab hier beide vom gleichen Typ */

		if (ta1.is_boolean && lv2.s.art.oa == op_xor) {
					/* Boolean XOR nicht moeglich */
			message (D_ERROR, "eval_constexpr: Boolean Expression impossible with XOR");
			YYERROR;
		}

		if (ta1.is_byte && (moduletype != e_LOWMOD)) {
					/* Integer OR, AND, XOR nicht moeglich */
			message (D_ERROR, "eval_constexpr: Integer Expression with AND, OR, XOR only in Lowlevel-Modules allowed");
			YYERROR;
		}

		if (lv2.s.art.oa == op_and) {
			retval.s.val.lv = lv1.s.val.lv & lv3.s.val.lv;
		} else if (lv2.s.art.oa == op_or) {
			retval.s.val.lv = lv1.s.val.lv | lv3.s.val.lv;
		} else {
			retval.s.val.lv = lv1.s.val.lv ^ lv3.s.val.lv;
		}
		return (retval);
		break;
	case op_plus:
	case op_minus:
					/* Int-, Real-Typen */
		if (  (!(ta1.is_shortreal || ta1.is_byte))
		    ||(!(ta3.is_shortreal || ta3.is_byte))) {
		    	break;
		}
		if (lv2.s.art.oa == op_minus) {		/* minus */
			if (ta3.is_shortreal) {
				lv3.s.val.dv *= -1;
			} else {
				lv3.s.val.lv *= -1;
				if (negative_stbltyp (lv3.s.art.stbltyp) && lv3.s.val.lv >= 0) {
					lv3.s.art.stbltyp = unsigned_const_stbltyp (lv3.s.val.lv);
				} else {
					lv3.s.art.stbltyp = negative_const_stbltyp (lv3.s.art.stbltyp);
				}
			}
		}
		if (ta1.is_shortreal && ta3.is_shortreal) {		/* real */
			if ((retval.s.art.stbltyp = maxtype (lv1.s.art.stbltyp, lv3.s.art.stbltyp)) == NULL) {
				message (D_ERROR, "eval_constexpr: Type overflow at Operator '%s'", lv2.s.val.ov);
				YYERROR;
			}
			retval.s.val.dv = lv1.s.val.dv + lv3.s.val.dv;
		} else if (( ! ta1.is_shortreal) && ta3.is_shortreal) {	/* int +- real */
			retval.s.art.stbltyp = lv3.s.art.stbltyp;
			retval.s.val.dv = ((double) lv1.s.val.lv) + lv3.s.val.dv;
		} else if (ta1.is_shortreal && ( ! ta3.is_shortreal)) {	/* real +- int */
			retval.s.art.stbltyp = lv1.s.art.stbltyp;
			retval.s.val.dv = lv1.s.val.dv + ((double) lv3.s.val.lv);
		} else {						/* int */
			retval.s.val.lv = lv1.s.val.lv + lv3.s.val.lv;
			if ((retval.s.art.stbltyp = maxtype (lv1.s.art.stbltyp, lv3.s.art.stbltyp)) == NULL) {
				message (D_ERROR, "eval_constexpr: Type overflow at Operator '%s'", lv2.s.val.ov);
				YYERROR;
			}
			if ((negative_stbltyp (retval.s.art.stbltyp) && retval.s.val.lv >= 0) ||
			   ! negative_stbltyp (retval.s.art.stbltyp)) {
				retval.s.art.stbltyp = unsigned_const_stbltyp (retval.s.val.lv);
			}
		}
		return (retval);
		break;
	case op_mal:
					/* Int-, Real-Typen */
		if (  (!(ta1.is_shortreal || ta1.is_byte))
		    ||(!(ta3.is_shortreal || ta3.is_byte))) {
		    	break;
		}
		if (ta1.is_shortreal && ta3.is_shortreal) {		/* real */
			if ((retval.s.art.stbltyp = maxtype (lv1.s.art.stbltyp, lv3.s.art.stbltyp)) == NULL) {
				message (D_ERROR, "eval_constexpr: Type overflow at Operator '%s'", lv2.s.val.ov);
				YYERROR;
			}
			retval.s.val.dv = lv1.s.val.dv * lv3.s.val.dv;
		} else if (( ! ta1.is_shortreal) && ta3.is_shortreal) {	/* int +- real */
			retval.s.art.stbltyp = lv3.s.art.stbltyp;
			retval.s.val.dv = ((double) lv1.s.val.lv) * lv3.s.val.dv;
		} else if (ta1.is_shortreal && ( ! ta3.is_shortreal)) {	/* real +- int */
			retval.s.art.stbltyp = lv1.s.art.stbltyp;
			retval.s.val.dv = lv1.s.val.dv * ((double) lv3.s.val.lv);
		} else {						/* int */
			retval.s.val.lv = lv1.s.val.lv * lv3.s.val.lv;
			if ((retval.s.art.stbltyp = maxtype (lv1.s.art.stbltyp, lv3.s.art.stbltyp)) == NULL) {
				message (D_ERROR, "eval_constexpr: Type overflow at Operator '%s'", lv2.s.val.ov);
				YYERROR;
			}
			if ((negative_stbltyp (lv1.s.art.stbltyp) && negative_stbltyp (lv3.s.art.stbltyp)) ||
			   !(negative_stbltyp (lv1.s.art.stbltyp) || negative_stbltyp (lv3.s.art.stbltyp))) {
							/* Ergebnis Positiv */
				retval.s.art.stbltyp = unsigned_const_stbltyp (retval.s.val.lv);
			} else {
			   				/* Ergebnis Negativ */
				retval.s.art.stbltyp = negative_const_stbltyp (unsigned_const_stbltyp (-retval.s.val.lv));
			}
		}
		return (retval);
		break;
	case op_div:
	case op_mod:
					/* Int-Typen */
		if (!(ta1.is_byte && ta3.is_byte)) {
		    	break;
		}
		if (lv2.s.art.oa == op_div) {		/* div */
			retval.s.val.lv = lv1.s.val.lv / lv3.s.val.lv;
		} else {				/* modulo */
			retval.s.val.lv = ((lv1.s.val.lv % lv3.s.val.lv) + lv3.s.val.lv) % lv3.s.val.lv;
		}
		if ((retval.s.art.stbltyp = maxtype (lv1.s.art.stbltyp, lv3.s.art.stbltyp)) == NULL) {
			message (D_ERROR, "eval_constexpr: Type overflow at Operator '%s'", lv2.s.val.ov);
			YYERROR;
		}
		if ((negative_stbltyp (lv1.s.art.stbltyp) && negative_stbltyp (lv3.s.art.stbltyp)) ||
		   !(negative_stbltyp (lv1.s.art.stbltyp) || negative_stbltyp (lv3.s.art.stbltyp))) {
						/* Ergebnis Positiv */
			retval.s.art.stbltyp = unsigned_const_stbltyp (retval.s.val.lv);
		} else {
		   				/* Ergebnis Negativ */
			retval.s.art.stbltyp = negative_const_stbltyp (unsigned_const_stbltyp (-retval.s.val.lv));
		}
		return (retval);
		break;
	case op_geteilt:
					/* Real-Typen */
		if (!(ta1.is_shortreal && ta3.is_shortreal)) {
		    	break;
		}
		retval.s.val.dv = lv1.s.val.dv / lv3.s.val.dv;
		return (retval);
		break;
	case op_gleich:
	case op_ungleich:
	case op_kleiner:
	case op_kleinergleich:
	case op_groesser:
	case op_groessergleich:
					/* Boolean, Int-, Real-Typen, Char, String */
		if ((retval.s.art.stbltyp = symbtbllookup ("boolean")) == NULL) {
			message (D_FATAL, "eval_constexpr: Boolean-Type not found");
			YYERROR;
		}
		if (ta1.is_char && ta3.is_char) {
					/* Char oder String */
			if (ta1.is_array && ta3.is_array) {
						/* String, String */
				l = strcmp (lv1.s.val.sv, lv3.s.val.sv);
			} else if (ta1.is_array && ! ta3.is_array) {
						/* String, Char */
				l = ((long) lv1.s.val.sv [0]) - lv3.s.val.lv;
				if (l == 0) {
					l = 1; /* erstes Zeichen in String == Char --> String ist graer */
				}
			} else if (! ta1.is_array && ta3.is_array) {
						/* Char, String */
				l = lv1.s.val.lv - ((long) lv3.s.val.sv [0]);
				if (l == 0) {
					l = -1; /* erstes Zeichen in String == Char --> Char ist kleiner */
				}
			} else {
						/* Char, Char */
				l = lv1.s.val.lv - lv3.s.val.lv;
			}
			retval.s.val.lv = m0_false;
			if ((lv2.s.art.oa == op_gleich) && (l == 0)){
				retval.s.val.lv = m0_true;
			} else if ((lv2.s.art.oa == op_ungleich) && (l != 0)) {
				retval.s.val.lv = m0_true;
			} else if ((lv2.s.art.oa == op_kleiner) && (l < 0)){
				retval.s.val.lv = m0_true;
			} else if ((lv2.s.art.oa == op_kleinergleich) && (l <= 0)){
				retval.s.val.lv = m0_true;
			} else if ((lv2.s.art.oa == op_groesser) && (l > 0)){
				retval.s.val.lv = m0_true;
			} else if ((lv2.s.art.oa == op_groessergleich) && (l >= 0)){
				retval.s.val.lv = m0_true;
			}
			return (retval);
		} else if ((ta1.is_boolean && ta3.is_boolean)
			  || (ta1.is_byte && ta3.is_byte)
			  || (ta1.is_enumeration && ta3.is_enumeration && (lv1.s.art.stbltyp->ofstblentry == lv1.s.art.stbltyp->ofstblentry))) {
					/* Boolean */
					/* Int-Typen */
					/* Enumeration-Typen */
			l = lv1.s.val.lv - lv3.s.val.lv;
			retval.s.val.lv = m0_false;
			if ((lv2.s.art.oa == op_gleich) && (l == 0)){
				retval.s.val.lv = m0_true;
			} else if ((lv2.s.art.oa == op_ungleich) && (l != 0)) {
				retval.s.val.lv = m0_true;
			} else if ((lv2.s.art.oa == op_kleiner) && (l < 0)){
				retval.s.val.lv = m0_true;
			} else if ((lv2.s.art.oa == op_kleinergleich) && (l <= 0)){
				retval.s.val.lv = m0_true;
			} else if ((lv2.s.art.oa == op_groesser) && (l > 0)){
				retval.s.val.lv = m0_true;
			} else if ((lv2.s.art.oa == op_groessergleich) && (l >= 0)){
				retval.s.val.lv = m0_true;
			}
			return (retval);
		} else if (ta1.is_shortreal && ta3.is_shortreal) {
					/* Real-Typen */
			d = lv1.s.val.dv - lv3.s.val.dv;
			retval.s.val.lv = m0_false;
			if ((lv2.s.art.oa == op_gleich) && (d == 0)){
				retval.s.val.lv = m0_true;
			} else if ((lv2.s.art.oa == op_ungleich) && (d != 0)) {
				retval.s.val.lv = m0_true;
			} else if ((lv2.s.art.oa == op_kleiner) && (d < 0)){
				retval.s.val.lv = m0_true;
			} else if ((lv2.s.art.oa == op_kleinergleich) && (d <= 0)){
				retval.s.val.lv = m0_true;
			} else if ((lv2.s.art.oa == op_groesser) && (d > 0)){
				retval.s.val.lv = m0_true;
			} else if ((lv2.s.art.oa == op_groessergleich) && (d >= 0)){
				retval.s.val.lv = m0_true;
			}
			return (retval);
		}
		break;
	default:
		break;
	}
					
	message (D_ERROR, "eval_constexpr: Operands and/or Operandtype incompatible in Constant Expression");
	YYERROR;
}


YYSTYPE
eval_const_stdfktn(fn, op)
	YYSTYPE	fn, op;
{
	TypeArt	ta;
	YYSTYPE	retval;
	long	l;
	double	d;

	ta = lookforgentypeart (op.s.art.stbltyp);

	retval = op;
	retval.s.flag.is_const = 1;
	retval.s.flag.is_lvalue = 0;

	if (strcmp (fn.s.val.ov, "float") == 0) {
		if (ta.is_byte) {
			retval.s.val.dv = (m0_longreal) op.s.val.lv;
			if ((retval.s.art.stbltyp = symbtbllookup ("shortreal")) == NULL) {
				message (D_FATAL, "eval_const_stdfktn: SHORTREAL-Type not found");
			}
		} else {
			message (D_ERROR, "eval_const_stdfktn: Invalid argument type at function FLOAT");
			retval.s.art.stbltyp = NULL;
		}
	} else if (strcmp (fn.s.val.ov, "trunc") == 0) {
		if (ta.is_shortreal) {
			retval.s.val.lv = (long) op.s.val.dv;
			if (retval.s.val.lv >= 0) {
				retval.s.art.stbltyp = unsigned_const_stbltyp (retval.s.val.lv);
			} else {
				retval.s.art.stbltyp = unsigned_const_stbltyp (- retval.s.val.lv);
				retval.s.art.stbltyp = negative_const_stbltyp (retval.s.art.stbltyp);
			}
		} else {
			message (D_ERROR, "eval_const_stdfktn: Invalid argument type at function TRUNC");
			retval.s.art.stbltyp = NULL;
		}
	} else if (strcmp (fn.s.val.ov, "ord") == 0) {
		if ((ta.is_char && ta.is_array == 0) || ta.is_enumeration) {
				/* lv is assigned already above */
			retval.s.art.stbltyp = unsigned_const_stbltyp (retval.s.val.lv);
		} else {
			message (D_ERROR, "eval_const_stdfktn: Invalid argument type at function ORD");
			retval.s.art.stbltyp = NULL;
		}
	} else if (strcmp (fn.s.val.ov, "chr") == 0) {
		if (ta.is_byte && ta.is_shortint == 0 && ta.is_shortcard == 0) {
				/* lv is assigned already above */
			if ((retval.s.art.stbltyp = symbtbllookup ("char")) == NULL) {
				message (D_FATAL, "eval_const_stdfktn: CHAR-Type not found");
			}
		} else {
			message (D_ERROR, "eval_const_stdfktn: Invalid argument type at function CHR");
			retval.s.art.stbltyp = NULL;
		}
	} else {
			/* may never be reached */
		message (D_FATAL, "eval_const_stdfktn: Invalid Function '%s'", fn.s.val.ov);
	}
	return (retval);
}



YYSTYPE
eval_expr(lv1, lv2, lv3)
	YYSTYPE	lv1, lv2, lv3;
{
	Types	*t1, *t3;
	TypeArt	ta1, ta3;
	YYSTYPE	retval;

	ta1 = lookforgentypeart (lv1.s.art.stbltyp);
	ta3 = lookforgentypeart (lv3.s.art.stbltyp);

	retval = lv1;
	retval.s.flag.is_const = 0;
	retval.s.flag.is_lvalue = 0;

	switch (lv2.s.art.oa) {
	case op_and:
	case op_or:
	case op_xor:
					/* Boolean, Int-Typen */
		if ((! (ta1.is_boolean || ta1.is_byte))
		    || (! (ta3.is_boolean || ta3.is_byte))) {
		    	break;
		}

		/* ab hier beide Boolean oder Int-Typ */
		
		if (ta1.is_boolean && ta3.is_byte) {
			break;
		}
		if (ta3.is_boolean && ta1.is_byte) {
			break;
		}

		/* ab hier beide vom gleichen Typ */

		if (ta1.is_boolean && lv2.s.art.oa == op_xor) {
					/* Boolean XOR nicht moeglich */
			message (D_ERROR, "eval_expr: Boolean Expression impossible with XOR");
			YYERROR;
		}

		if (ta1.is_byte && (moduletype != e_LOWMOD)) {
					/* Integer OR, AND, XOR nicht moeglich */
			message (D_ERROR, "eval_expr: Integer Expression with AND, OR, XOR only in Lowlevel-Modules allowed");
			YYERROR;
		}
		return (retval);
		break;
	case op_plus:
	case op_minus:
	case op_mal:
					/* Int-, Real-Typen */
		if (  (!(ta1.is_shortreal || ta1.is_byte))
		    ||(!(ta3.is_shortreal || ta3.is_byte))) {
		    	break;
		}
		if (lv2.s.art.oa == op_minus) {		/* minus */
			if (ta3.is_byte) {
				if ((retval.s.art.stbltyp = maxtype (lv1.s.art.stbltyp, lv3.s.art.stbltyp)) == NULL) {
					YYERROR;
				}
			}
		}
		if (ta3.is_shortreal) {
					/*
					 * Ergebnis ist Real, weitere Abfrage nicht ntig, da:
					 * Wenn (ta1 <=> real) oder (ta1 und ta3 <=> byte), bereits oben gesetzt!
					 */
			retval.s.art.stbltyp = lv3.s.art.stbltyp;
		}
		return (retval);
		break;
	case op_div:
	case op_mod:
					/* Int-Typen */
		if (!(ta1.is_byte && ta3.is_byte)) {
		    	break;
		}
		if ((retval.s.art.stbltyp = maxtype (lv1.s.art.stbltyp, lv3.s.art.stbltyp)) == NULL) {
			message (D_ERROR, "eval_expr: Type overflow at Operator '%s'", lv2.s.val.ov);
			YYERROR;
		}
		if (negative_stbltyp (lv1.s.art.stbltyp) || negative_stbltyp (lv3.s.art.stbltyp)) {
		   				/* Ergebnis kann negativ sein */
			retval.s.art.stbltyp = negative_const_stbltyp (retval.s.art.stbltyp);
		}
		return (retval);
		break;
	case op_geteilt:
					/* Real-Typen */
		if (!(ta1.is_shortreal && ta3.is_shortreal)) {
		    	break;
		}
		return (retval);
		break;
					/* Boolean, Int-, Real-Typen, Char, String */
	case op_gleich:
	case op_ungleich:
	case op_kleiner:
	case op_kleinergleich:
	case op_groesser:
	case op_groessergleich:
		if ((retval.s.art.stbltyp = symbtbllookup ("boolean")) == NULL) {
			message (D_FATAL, "eval_expr: Boolean-Type not found");
			YYERROR;
		}
		t1 = lv1.s.art.stbltyp->u.oftype;
		t3 = lv3.s.art.stbltyp->u.oftype;
		if ((ta1.is_char || (t1->tart.is_array && t1->oftype->u.oftype->tart.is_char))
		   && (ta3.is_char || (t3->tart.is_array && t3->oftype->u.oftype->tart.is_char))) {
					/* Char oder String */
			if (! ta1.is_array && ! ta3.is_array) {
			
						/* Char, Char */
				get_expr_pos ();
				insert_exbuf (get_expr_pos (), lv2.s.val.ov);
				get_expr_pos ();
				get_expr_pos ();

			} else if (ta1.is_array && ta3.is_array) {

						/* String, String */
				get_expr_pos ();
				get_expr_pos ();
				if (lv1.s.flag.is_const) {
					insert_exbuf (get_expr_pos (), ",");
				} else {
					insert_exbuf (get_expr_pos (), ".a,");
				}
				insert_exbuf (get_expr_pos (), "(strcmp (");
				if (! lv3.s.flag.is_const) {
					c_exbuf (".a");
				}
				c_exbuf (") %s 0)", lv2.s.val.ov);
				
			} else if (ta1.is_array && ! ta3.is_array) {

						/* String, Char */
				get_expr_pos ();
				insert_exbuf (get_expr_pos (), ", mk_str (");
				if (lv1.s.flag.is_const) {
					get_expr_pos ();
				} else {
					insert_exbuf (get_expr_pos (), ".a");
				}
				insert_exbuf (get_expr_pos (), "(strcmp (");
				c_exbuf (")) %s 0)", lv2.s.val.ov);

			} else if (! ta1.is_array && ta3.is_array) {

						/* Char, String */
				get_expr_pos ();
				get_expr_pos ();
				insert_exbuf (get_expr_pos (), "), ");
				insert_exbuf (get_expr_pos (), "(strcmp (mk_str (");
				if (! lv3.s.flag.is_const) {
					c_exbuf (".a");
				}
				c_exbuf (") %s 0)", lv2.s.val.ov);
			} else {
				break;
			}
			return (retval);
		} else if ((ta1.is_boolean && ta3.is_boolean)
			  || (ta1.is_byte && ta3.is_byte)
			  || (ta1.is_shortreal && ta3.is_shortreal)) {
					/* Boolean */
					/* Int-Typen */
					/* Real-Typen */
			/* bereits o. k. (siehe modula.yac) */
			return (retval);
		} else if (ta1.is_pointer || ta1.is_enumeration || ta1.is_subrange || ta1.is_array || ta1.is_record) {
					/* restliche Typen */
			if (lv1.s.art.stbltyp->ofstblentry == lv1.s.art.stbltyp->ofstblentry) {
				if (ta1.is_pointer || ta1.is_enumeration || ta1.is_subrange) {
					/* bereits o. k. (siehe modula.yac) */
					return (retval);
				}
				get_expr_pos ();
				insert_exbuf (get_expr_pos (), ", ");
				get_expr_pos ();
				insert_exbuf (get_expr_pos (), "(memcmp (");
				c_exbuf (", sizeof (");
				c_exbuf_id (lv1.s.val.pstbl);
				c_exbuf (")) %s 0)", lv2.s.val.ov);
				return (retval);
			}
		}
		break;
	default:
		break;
	}
					
	message (D_ERROR, "eval_expr: Operands and/or Operandtype incompatible in Expression");
	YYERROR;
}

char	*
ex_pos(i)
	int	i;
{
#define MAX_EX_POS	64
	static	char	*(ca[MAX_EX_POS]);
	static	int	pos = 0;

	switch (i) {
	case 0:		/* clear */
		pos = 0;
		break;
	case 1:		/* put */
		if (pos >= MAX_EX_POS) {
			message (D_FATAL, "ex_pos: Expression too complex. Expression-Buffer overflow at Token '%s'", yytext);
		}
		ca [pos] = expression_buffer + strlen (expression_buffer);
		pos++;
		return (ca [pos-1]);
		break;
	case 2:		/* get */
		if (pos <= 0) {
			message (D_ERROR, "ex_pos: Expression-Buffer underflow at Token '%s'. Cause is an earlier Error", yytext);
			break; /* return begin of expr-buf s. u. */
		}
		pos--;
		return (ca [pos]);
		break;
	case 3:		/* show */
		if (pos <= 0) {
			break; /* return begin of expr-buf s. u. */
		}
		return (ca [pos - 1]);
		break;
	default:
		message (D_FATAL, "ex_pos: Illegal Switch '%d'", i);
		break;
	}
	return (expression_buffer);
}
