/************************************************************************/
/*                                                                      */
/* Copyright (c) 1988 -                                                 */
/*     The Rector and Visitors of the University of Virginia            */
/*                                                                      */
/* This code may not be distributed further without permission          */
/*      from the University of Virginia.                                */
/* This code is distributed WITHOUT ANY WARRANTY.  No claims are        */
/*      made as to whether it serves any particular purpose or even     */
/*      works at all.                                                   */
/*                                                                      */
/************************************************************************/

/*
 * This source file has the code for building parse tree nodes.  A tree
 * NODE is a struct  comprised of several fields whose names start with
 * "nd_" and a union called "nd".
 *
 * nd_op (int) operation specified by this NODE.
 *
 * nd_type (TWORD) type of this NODE (see tword.h).  Each node
 * represents a computable value and nd_type is the value's type.
 *
 * nd_object (OBJECT*) pointer to symbol table entry
 *
 * nd.tn.ival (int) integer value of constant or label NODE
 *
 * nd.tn.rval (double) value of real constant NODE
 *
 * nd.tn.runtime (char*) name of a run time function
 *
 * nd.in.left (NODE*) left branch of parse tree
 *
 * nd.in.right (NODE*) right branch of parse tree
 *
 * How these fields are used depends on the operator in nd_op.  These
 * are the legal operators and their meanings:
 *
 *     ND_ABS:      abs(nd.in.left)
 *     ND_ADDRESS:  Emit address of variable pointed to by nd_object.
 *     ND_CALL:     Call the function whose address is nd.in.left,
 *                  passing the argument list in nd.in.right.
 *                  The function return type is nd_type.
 *     ND_CBRANCH:  Emit jump to the label nd.in.right when the boolean
 *                  expression nd.in.left is false.
 *     ND_DEREF:    Dereference address in nd.in.left.
 *     ND_FREE:     NODE is free
 *     ND_ICON:     NODE is a constant.  If nd_type is TW_DOUBLE, the
 *                  value is in nd.tn.rval, otherwise nd.tn.ival.
 *     ND_LSHIFT:   Left shift  nd.in.left << nd.in.right.  Optimizer
 *                  converts multiplication by power of 2 to shift.
 *     ND_ODD:      odd(nd.in.left) 
 *     ND_PCONV:    Coerce pointer expr nd.in.left to type nd_type.
 *     ND_RANGE:    Emit range check code to be sure that
 *                  nd.in.right->nd.in.left <= nd.in.left <=
 *                  nd.in.right->nd.in.right
 *     ND_ROUND:    round(nd.in.left)
 *     ND_RTFUNC:   Emit the address of a run time function whose name
 *                  is nd.tn.runtime.
 *     ND_SCONV:    Coerce expr nd.in.left to type nd_type
 *     ND_SQR:      sqr(nd.in.left)
 *     ND_STARG:    Pass non-simple (eg. array) variable as parameter.
 *                  nd.in.left is address of variable, nd_object points
 *                  to symbol table entry for type of variable.
 *     ND_STASG:    Copy non-simple (eg array) variable nd.in.right
 *                  to address nd.in.left.  nd_object points to symbol
 *                  table entry for the type of nd.in.right
 *     ND_TRUNC:    trunc(nd.in.left)
 *     ND_UMINUS:   Unary minus (-nd.in.left)
 *     SY_AND:      nd.in.left "and" nd.in.right
 *     SY_ASSIGN:   nd.in.left := nd.in.right
 *     SY_COMMA:    Links together function parameters.  Also links
 *                  lower, upper bound of range check.
 *     SY_DIV:      nd.in.left "div" nd.in.right
 *     SY_EQUAL:    nd.in.left = nd.in.right
 *     SY_GE:       nd.in.left >= nd.in.right
 *     SY_GT:       nd.in.left > nd.in.right
 *     SY_LABEL:    Node is a label whose value is nd.tn.ival
 *     SY_LE:       nd.in.left <= nd.in.right
 *     SY_LT:       nd.in.left < nd.in.right
 *     SY_MINUS:    nd.in.left - nd.in.right
 *     SY_MOD:      nd.in.left "mod" nd.in.right
 *     SY_NE:       nd.in.left <> nd.in.right
 *     SY_NOT:      "not" nd.in.left
 *     SY_OR:       nd.in.left "or" nd.in.right
 *     SY_PLUS:     nd.in.left + nd.in.right
 *     SY_SLASH:    nd.in.left / nd.in.right
 *     SY_STAR:     nd.in.left * nd.in.right
 */

#include <string.h>
#include "types.h"
#include "tword.h"
#include "size.h"
#include "scan.h"
#include "object.h"
#include "node.h"
#include "error.h"

#define ND_SIZE 300

static NODE node[ND_SIZE];

/*
 * nd_init() sets all the parse tree nodes in the pool to "free"
 */

nd_init()
{
	register NODE *p = node+ND_SIZE;
	while(p > node)
		(--p)->nd_op = ND_FREE;
}

/*
 * nd_alloc() gets a free parse tree node from the pool of nodes.
 */

NODE *
nd_alloc()
{
	static NODE *lastfree = node;
	register NODE *p;
	for (p = lastfree+1; p != lastfree; p >= node+ND_SIZE ? p = node : p++) {
		if (p->nd_op == ND_FREE)
			return (lastfree = p);
	}
	strcpy(err_text,"no free tree nodes in \"nd_alloc()\"");
	err_msg(E_INTERNAL, E_CURLINE);
	return (ND_NULL);
}

/*
 * nd_freetree() recursively marks all nodes in a parse tree as "free"
 * Note that sometimes the compiler needs auxiliary variables for
 * internal use.  These variables are freed for re-use when encountered
 * in the parse tree.
 */

nd_freetree(p)
	register NODE *p;
{
	if (p) {
		switch(p->nd_op) {
		
		case ND_ICON:	/* leaf nodes */
		case SY_LABEL:
		case ND_FREE:
		case ND_RTFUNC:
			break;
		case ND_ADDRESS:
			if (p->nd_object->ob_flags & OB_FREETMP) {
				p->nd_object->ob_flags &= ~OB_FREETMP;
				ob_freetmp(p->nd_object);
			}
			break;

		default:	/* interior nodes */
			nd_freetree(p->nd.in.left);
			nd_freetree(p->nd.in.right);
			break;
		}
		p->nd_op = ND_FREE;
	}
}


/*
 * nd_const() builds a parse tree node from a constant object.
 */

NODE *
nd_const(const)
	register OBJECT *const;
{
	register NODE *ret;

	ret = nd_alloc();
	ret->nd_op = TW_ISPTR(const->ob_tword) ? SY_LABEL : ND_ICON;
	ret->nd_type = const->ob_tword;
	ret->nd_object = OB_NULL;
	if (const->ob_type == std_real)
		ret->nd.tn.rval = const->ob.const.val.r;
	else
		ret->nd.tn.ival = const->ob.const.val.i;
	return (ret);
}

/*
 * nd_icon() builds a parse tree node with the specified constant
 * value and type.
 */

NODE *
nd_icon(i, tw)
	int i;
	TWORD tw;
{
	register NODE *ret;
	ret = nd_alloc();
	ret->nd_op = ND_ICON;
	ret->nd_type = tw;
	ret->nd_object = OB_NULL;
	ret->nd.tn.ival = i;
	return(ret);
}

/*
 * nd_address() builds a parse tree for computing the address
 * of an object.  Note that if the object is a field, we are
 * inside a "with" statement.  The address of the record that
 * owns the field has been stashed in a temporary variable
 * and this temporary is in the symbol table.  Note also that
 * variable parameters, functional parameters, and conformant
 * array parameters are pointers that must be dereferenced to
 * obtain the address of the object.
 */

NODE *
nd_address(object)
	register OBJECT *object;
{
	register NODE *ret;
	register int deref=0;
	register TWORD tw;
	if (object->ob_kind == OB_FIELD) {
		/*
		 * inside a with statement.  Must get the address that
		 * we saved in p_with_stmt() and add the field offset to it.
		 */
		ret = nd_value(ob_block[object->ob_level]);
		tw = object->ob_tword;
		ret = nd_build(ND_PCONV, tw = TW_INCREF(tw), ret, ND_NULL);
		ret = nd_build(SY_PLUS, tw, ret,
			nd_icon(object->ob.field.offset, TW_INT));
		return(ret);
	}
	ret = nd_alloc();
	ret->nd_op = ND_ADDRESS;
	ret->nd_type = TW_INCREF(object->ob_tword);
	ret->nd_object = object;

	switch (object->ob_kind) {

	case OB_FUNC:
	case OB_PROC:
		if (object->ob_flags & OB_PARMSUBP)  /* functional parameter */
			deref++;
		break;

	case OB_VARPARM:
		deref++;
		break;

	case OB_VALPARM:
		if (object->ob_type->ob_kind == OB_CONFARRAY)
			deref++;
		break;
	}

	if (deref)
		ret = nd_build(ND_DEREF, object->ob_tword, ret, ND_NULL);
	return(ret);
}

/*
 * nd_runtime() builds a run time function node -- for emitting
 * a call to a run time system function.
 */

NODE *
nd_runtime(name, tword)
	char *name;
	register TWORD tword;
{
	register NODE *ret;

	ret = nd_alloc();
	ret->nd_op = ND_RTFUNC;
	ret->nd_type = TW_ISFTN(tword) ? tword :
		TW_INCREF(tword) + TW_FTN - TW_PTR;
	ret->nd_object = OB_NULL;
	ret->nd.tn.runtime = name;
	return(ret);
}

/*
 * nd_value() builds a tree to get the value of a variable.
 * First gets the address and then dereferences.
 */

NODE *
nd_value(var)
	register OBJECT *var;
{
	return(nd_build(ND_DEREF, var->ob_tword, nd_address(var), ND_NULL));
}

/*
 * nd_label() builds a node that is either a statement label or
 * the address of a string constant.
 */
	
NODE *
nd_label(label)
	int label;
{
	register NODE *ret;
	ret = nd_alloc();
	ret->nd_op = SY_LABEL;
	ret->nd_type = TW_PTR+TW_CHAR;
	ret->nd_object = OB_NULL;
	ret->nd.tn.ival = label;
	return(ret);
}

/*
 * nd_build() constructs an interior (non-leaf) node.  nd_build does
 * some simple optimizations in cases where a new node is not
 * necessary.  For example, if two constant nodes are being added,
 * nd_build adds the constants together and returns the result in
 * a constant node.
 */

NODE *
nd_build(op, tword, left, right)
	register int op;
	register TWORD tword;
	register NODE *left, *right;
{
	register NODE *ret;

	/* We may only need to modify an existing node */

	switch(op) {

	case ND_PCONV:  /* conversion to same type */
		if (tword == left->nd_type)
			return(left);
		if (left->nd_op == ND_PCONV) { /* two conversions */
			left->nd_type = tword;
			return(left);
		}
		break;

	case ND_SCONV:
		if (tword == left->nd_type)  /* conversion to same type */
			return(left);

		/* ordinal constants can be converted in advance */

		if (left->nd_op == ND_ICON && left->nd_type != TW_DOUBLE) {
			if (tword == TW_DOUBLE)
				left->nd.tn.rval = left->nd.tn.ival;
			left->nd_type = tword;
			return(left);
		}
		break;

	case ND_UMINUS:
		switch (left->nd_op) {

		/* convert -(-e) to e */

		case ND_UMINUS:
			left->nd_op = ND_FREE;
			return(left->nd.in.left);

		/* convert -(e1 - e2) to (e2 - e1) */

		case SY_MINUS:
			right = left->nd.in.right;
			left->nd.in.right = left->nd.in.left;
			left->nd.in.left = right;
			return(left);
		}
		break;
	}

	/* do arithmetic when both left and right are constants */

	if (left->nd_op == ND_ICON && (!right || right->nd_op == ND_ICON) &&
		nd_conval(op, left, right))
	{
		left->nd_type = tword;
		if (right)
			right->nd_op = ND_FREE;
		return(left);
	}

	/*
	 * Must build a new node.  In order to generate code that the
	 * peephole optimizer can improve and that uses fewer registers,
	 * we try to put constants and dereferences on the right hand side.
	 * Note that code for the left side will be emitted before the right.
	 */

	ret = nd_alloc();
	ret->nd_op = op;
	ret->nd_type = tword;
	ret->nd_object = OB_NULL;

	if (right && right->nd_op != ND_ICON &&
		(left->nd_op == ND_ICON || left->nd_op == ND_DEREF))
	{
		switch(op) {
	
		/* commutative operators -- tree is reversible */

		case SY_PLUS:
		case SY_STAR:
		case SY_EQUAL:
		case SY_NE:
			break;
		
		/* must transform these operators to reverse tree */

		case SY_LT:
			ret->nd_op = SY_GT;
			break;
	
		case SY_LE:
			ret->nd_op = SY_GE;
			break;
	
		case SY_GT:
			ret->nd_op = SY_LT;
			break;
	
		case SY_GE:
			ret->nd_op = SY_LE;
			break;

		default:
			goto out;
		}

		/* build tree in reverse order */

		ret->nd.in.left = right;
		ret->nd.in.right = left;
		return(ret);
	}
out:

	/* build tree in the specified order */

	ret->nd.in.left = left;
	ret->nd.in.right = right;
	return (ret);
}

/*
 * trunc() converts a double to an int as specified by Pascal's "trunc".
 * Note that in C, double to integer conversion is implementation
 * dependent.
 */

static int
trunc(x)
	double x;
{
	register int ret;

	if (x < -SZ_MAXINT || x > SZ_MAXINT) {
		strcpy(err_text, "real value too large/small to convert");
		err_msg(E_FATAL, E_PREVSYMBOL);
	}
	ret = (int)x;
	return (x < 0.0 ? ret + (ret < x) : ret - (ret > x));
}

/*
 * nd_conval() evaluates the constant expression (c1 op c2) or (op c) and
 * places the result in left.  Returns 1 if expression was evaluated,
 * otherwise 0.
 */

int
nd_conval(op, left, right)
	int op;
	register NODE *left, *right;
{
	register TWORD ltype;
	char *errflag = (char*)0;

	ltype = left->nd_type;

	switch (op) {

	case ND_UMINUS:
		if (ltype != TW_DOUBLE)
			left->nd.tn.ival = -left->nd.tn.ival;
		else
			left->nd.tn.rval = -left->nd.tn.rval;
		break;

	case SY_NOT:
		left->nd.tn.ival = !left->nd.tn.ival;
		break;

	case SY_PLUS:
		if (ltype != TW_DOUBLE)
			left->nd.tn.ival += right->nd.tn.ival;
		else
			left->nd.tn.rval += right->nd.tn.rval;
		break;

	case SY_MINUS:
		if (ltype != TW_DOUBLE)
			left->nd.tn.ival -= right->nd.tn.ival;
		else
			left->nd.tn.rval -= right->nd.tn.rval;
		break;

	case SY_STAR:
		if (ltype != TW_DOUBLE)
			left->nd.tn.ival *= right->nd.tn.ival;
		else
			left->nd.tn.rval *= right->nd.tn.rval;
		break;

	case SY_DIV:
	case SY_SLASH:
		if (ltype != TW_DOUBLE) {
			if (right->nd.tn.ival == 0)
				errflag = "division by zero";
			else
				left->nd.tn.ival /= right->nd.tn.ival;
		}
		else {
			if (right->nd.tn.rval == 0.0)
				errflag = "division by zero";
			else
				left->nd.tn.rval /= right->nd.tn.rval;
		}
		break;

	case SY_MOD:
		if (right->nd.tn.ival <= 0)
			errflag = "second \"mod\" operand <= zero";
		else {
			left->nd.tn.ival %= right->nd.tn.ival;
			if (left->nd.tn.ival < 0)
				left->nd.tn.ival += right->nd.tn.ival;
		}
		break;

	case SY_LT:
		if (ltype != TW_DOUBLE)
			left->nd.tn.ival = left->nd.tn.ival < right->nd.tn.ival;
		else
			left->nd.tn.rval = left->nd.tn.rval < right->nd.tn.rval;
		break;

	case SY_LE:
		if (ltype != TW_DOUBLE)
			left->nd.tn.ival = left->nd.tn.ival <= right->nd.tn.ival;
		else
			left->nd.tn.rval = left->nd.tn.rval <= right->nd.tn.rval;
		break;

	case SY_EQUAL:
		if (ltype != TW_DOUBLE)
			left->nd.tn.ival = left->nd.tn.ival == right->nd.tn.ival;
		else
			left->nd.tn.rval = left->nd.tn.rval == right->nd.tn.rval;
		break;

	case SY_NE:
		if (ltype != TW_DOUBLE)
			left->nd.tn.ival = left->nd.tn.ival != right->nd.tn.ival;
		else
			left->nd.tn.rval = left->nd.tn.rval != right->nd.tn.rval;
		break;

	case SY_GE:
		if (ltype != TW_DOUBLE)
			left->nd.tn.ival = left->nd.tn.ival >= right->nd.tn.ival;
		else
			left->nd.tn.rval = left->nd.tn.rval >= right->nd.tn.rval;
		break;

	case SY_GT:
		if (ltype != TW_DOUBLE)
			left->nd.tn.ival = left->nd.tn.ival > right->nd.tn.ival;
		else
			left->nd.tn.rval = left->nd.tn.rval > right->nd.tn.rval;
		break;

	case SY_OR:
		left->nd.tn.ival = left->nd.tn.ival || right->nd.tn.ival;
		break;
	
	case SY_AND:
		left->nd.tn.ival = left->nd.tn.ival && right->nd.tn.ival;
		break;

	case ND_SQR:
		if (ltype != TW_DOUBLE)
			left->nd.tn.ival *= left->nd.tn.ival;
		else
			left->nd.tn.rval *= left->nd.tn.rval;
		break;

	case ND_ABS:
		if (ltype != TW_DOUBLE) {
			if (left->nd.tn.ival < 0)
				left->nd.tn.ival = -left->nd.tn.ival;
		}
		else if (left->nd.tn.rval < 0.0)
			left->nd.tn.rval = -left->nd.tn.rval;
		break;

	case ND_TRUNC:
		left->nd.tn.ival = trunc(left->nd.tn.rval);
		break;

	case ND_ROUND:
		if (left->nd.tn.rval >= 0.0)
			left->nd.tn.ival = trunc(left->nd.tn.rval + 0.5);
		else
			left->nd.tn.ival = trunc(left->nd.tn.rval - 0.5);
		break;

	case ND_ODD:
		left->nd.tn.ival &= 1;
		break;

	default:
		return(0);		/* didn't do anything */
	}

	if (errflag) {
		strcpy(err_text, errflag);
		err_msg(E_FATAL, E_PREVSYMBOL);
	}
	return(1);
}

/*
 * nd_sclass() returns the storage class of an object 
 */

int
nd_sclass(ob)
	OBJECT *ob;
{
	switch(ob->ob_kind) {

	case OB_VALPARM:
	case OB_VARPARM:
	case OB_BOUNDID:
		return(SC_PARAM);

	case OB_VARIABLE:
		return(SC_AUTO);

	case OB_FIELD:
		return(SC_MOS);

	case OB_LABEL:
		return(SC_LABEL);

	case OB_FUNC:
	case OB_PROC:
		if (ob->ob_flags & OB_PARMSUBP)	/* parameter subprogram */
			return(SC_PARAM);
		return(SC_EXTDEF);
	}
	return(SC_NULL);
}
